How do I take the data from one populated treeview and put it into another existing treeview.
All the nodes and children need to be copied.
I think you can use a stream to save and load tree content. I don't have a running environment right now to test an example but, your code could looks like :
var
MS: TMemoryStream;
begin
MS := TMemoryStream.Create;
try
Tree1.SaveToStream(MS);
MS.Position := 0;
Tree2.LoadFromStream(MS);
finally
MS.Free;
end;
end;
TTreeNode implements the TPersistent.Assign() method, so one option would be to write a recursive function that iterates the source TreeView adding-and-assigning nodes to the target TreeView. For example:
procedure CopyNodes(SrcTree, DstTree: TTreeView);
var
DstNodes: TTreeNodes;
SrcRootNode: TTreeNode;
procedure DoCopyNodes(SrcNode, Relative: TTreeNode; AddMode: TNodeAttachMode);
var
DstNode: TTreeNode;
begin
while SrcNode <> nil do
begin
DstNode := DstNodes.AddNode(nil, Relative, '', nil, AddMode);
try
DstNode.Assign(SrcNode);
DoCopyNodes(SrcNode.GetFirstChild, DstNode, naAddChild);
except
DstNode.Delete;
raise;
end;
SrcNode := SrcNode.GetNextSibling;
end;
end;
begin
SrcRootNode := SrcTree.Items.GetFirstNode;
if SrcRootNode <> nil then
begin
DstNodes := DstTree.Items;
DstNodes.BeginUpdate;
try
DoCopyNodes(SrcRootNode, nil, naAdd);
finally
DstNodes.EndUpdate;
end;
end;
end;
CopyNodes(TreeView1, TreeView2);
Related
I have a TFrame that is Inherited from a TBaseFrame = class(TFrame)
Inside this there is an embeded TFrame with same inheritence
TViewStandardMovimentoFinanceiro = class(TFrameBase)
ViewStandardEdiMovimentoFinanceiro1: TViewStandardEdiMovimentoFinanceiro;
TViewStandardEdiMovimentoFinanceiro = class(TFrameBase)
TFrameBase = class(TFrame, INaharView, INaharViewAdapter)
The TViewStandardMovimentoFinanceiro is created with parent set to the main form (particularly to a THorzScrollBox)
From INSIDE the TViewStandardMovimentoFinanceiro frame I tried the classical approach of using the Children list and have not found that embedded TFrame.
I have tried also using the Parent`s Children list with no success. Same thing with the Components List
What I want to do is to to locate all available TFrames so I can ask for an interface (I know how to do that)
What am I missing?
Following recommendations bellow I have implemented this code for testing:
function TFrameBase.LocateControl(AControl: TControl; ADomainName: string): TControlHandler;
var
NaharView: INaharView;
ControlHandler: TControlHandler;
i: integer;
begin
result := nil;
for i := 0 to AControl.ChildrenCount - 1 do
if (AControl.Children[i] is TFrame) and (AControl.Children[i] <> Self) then
if Supports((AControl.Children[i] as TFrame), INaharView, NaharView) then
begin
ControlHandler := NaharView.Control[ADomainName];
if Assigned(ControlHandler) then
exit(ControlHandler);
end;
end;
function GetUltimateParent(Control: TControl): TControl;
begin
if Control.Parent is TControl then
Result := GetUltimateParent(TControl(Control.Parent))
else
Result := Control;
end;
function TFrameBase.GetNaharControl(ADomainName: string): TControlHandler;
var
i: integer;
ControlHandler: TControlHandler;
begin
if NaharControls.ContainsKey(ADomainName) then
Exit(NaharControls.Items[ADomainName])
else
begin
ControlHandler := LocateControl(GetUltimateParent(Self), ADomainName);
if Assigned(ControlHandler) then
exit(ControlHandler);
end;
raise EViewControlDomainNameNotFound.Create(ADomainName);
end;
When LocateControl is executed it goes several levels to the top and from there it tries to iterate on Children List, it only contains 3 items in a form form full of controls.
Your function LocateControl need to be recursive, as stated by Ondrej. Something like this
function TFrameBase.LocateControl(AControl: TControl; ADomainName: string): TControlHandler;
var
NaharView: INaharView;
ControlHandler: TControlHandler;
i: integer;
begin
result := nil;
for i := 0 to AControl.ChildrenCount - 1 do
begin
if (AControl.Children[i] is TFrame) and (AControl.Children[i] <> Self) then
begin
if Supports((AControl.Children[i] as TFrame), INaharView, NaharView) then
begin
ControlHandler := NaharView.Control[ADomainName];
if Assigned(ControlHandler) then
begin
exit(ControlHandler);
end;
end;
end;
// recursive bit
Result := LocateControl(AControl.Children[i], ADomainName):
if assigned( Result ) then
begin
exit;
end;
end;
end;
I have a function to update a cxGrid made with help from answers to Loop through records on a cxgrid and update a field/column
But it is sometimes acting a bit strange. If I open the form with the cxGrid and click the columnheader without doing anything else, the records are updateted OK. But if the 'selectorbar' is moved away from the top, the record marked is not updated.
I am sure it is a property that needs to be changed, but which one.
The variable fSelected is set to False at FormShow and is ther so that the user can unselect records as well.
procedure TfrmContactsSelect.colContactSelectedHeaderClick(Sender: TObject);
var
i: Integer;
Index: Integer;
BookMark : TBookMark;
Contact: variant;
begin
if fMulti = True then
begin
Screen.Cursor := crHourGlass;
fSelected := not fSelected;
BookMark := qryContacts.GetBookmark;
qryContacts.DisableControls;
try
for i := 0 to grdContactsView1.DataController.FilteredRecordCount - 1 do
begin
Index := grdContactsView1.DataController.FilteredRecordIndex[i];
Contact := grdContactsView1.DataController.Values[Index, 4];
if grdContactsView1.DataController.LocateByKey(Contact) then
begin
qryContacts.Edit;
qryContacts.FieldByName('fldcontact_selected').AsBoolean := fSelected;
qryContacts.Post;
end;
end;
finally
qryContacts.EnableControls;
qryContacts.GotoBookmark(BookMark);
qryContacts.FreeBookmark(BookMark);
end;
Screen.Cursor := crDefault;
end;
end;
Delphi XE7, DevExpress 14.2.2, UniDAC 5.5.12 for DB access
Comment:
I have ended up with the following solution based on the answer and input from MartynA
procedure TfrmContactsSelect.colContactSelectedHeaderClick(Sender: TObject);
var
i: Integer;
Index: Integer;
MarkedRecord: variant;
CurrentRecord: variant;
begin
if fMulti = True then
begin
Screen.Cursor := crHourGlass;
fSelected := not fSelected;
Index := grdContactsView1.DataController.FocusedRecordIndex;
MarkedRecord := grdContactsView1.DataController.Values[Index, colContactGuid.ID];
try
for i := 0 to grdContactsView1.DataController.FilteredRecordCount - 1 do
begin
Index := grdContactsView1.DataController.FilteredRecordIndex[i];
CurrentRecord := grdContactsView1.DataController.Values[Index, colContactGuid.ID];
if grdContactsView1.DataController.LocateByKey(CurrentRecord) then
begin
grdContactsView1.DataController.Edit;
grdContactsView1.DataController.SetEditValue(colContactSelected.ID, fSelected, evsText);
grdContactsView1.DataController.Post;
end;
end;
finally
grdContactsView1.DataController.LocateByKey(MarkedRecord);
end;
Screen.Cursor := crDefault;
end;
end;
I can reproduce your problem using the sample project I posted in my answer to your other q.
Try this: Add a TMemo to your form, and inside the 'if grdContactsView1.DataController.LocateByKey(Contact) then' block, write the value of a row-unique datafield and the Selected datafield value to the memo.
Then, what I get when some row other than the top row is selected is that one row is listed twice in the memo, with Selected both false and true, and one of the rows in the filter isn't listed at all, which I think accounts for the behaviour you're seeing. If I then comment out the .Edit .. .Post lines, it correctly lists all the rows in the filter.
So evidently doing the Selected field changes inside a block which iterated the FilteredRecordIndex property of the DBTableView is what's causing the problem.
Personally, I find that it goes a bit against the grain to modify dataset rows in code via a DB-aware control (because you usually end up fighting the DB-awareness of the control), but in this case, it's straightforward to do the processing via the DBTableView of the cxGrid.
procedure TForm1.ProcessFilteredRecords;
var
PrevV,
V : Variant;
i,
Index: Integer;
S : String;
begin
// First, pick up a reference to the current record
// so that we can return to it afterwards
Index := cxGrid1DBTableView1.DataController.FocusedRecordIndex;
PrevV := cxGrid1DBTableView1.DataController.Values[Index, 0];
try
for i := 0 to cxGrid1DBTableView1.DataController.FilteredRecordCount - 1 do begin
Index := cxGrid1DBTableView1.DataController.FilteredRecordIndex[i];
V := cxGrid1DBTableView1.DataController.Values[Index, 0];
if cxGrid1DBTableView1.DataController.LocateByKey(V) then begin
cxGrid1DBTableView1.DataController.Edit;
// 2 is the index of my Selected column in the grid
if cxGrid1DBTableView1.DataController.SetEditValue(2, True, evsText) then
Caption := 'OK'
else
Caption := 'Failed';
cxGrid1DBTableView1.DataController.Post;
end;
end;
finally
if cxGrid1DBTableView1.DataController.LocateByKey(PrevV) then
Caption := 'OK'
else
Caption := 'Failed';
end;
end;
Another way to avoid the problem is to change the Selected states in two steps:
Iterate the FilteredRecordIndex to build a list of rows to change - in your case this would be a list of guids
Then, iterate the list of rows and update their Selected states.
Code:
procedure TForm1.ProcessFilteredRecords;
var
V : Variant;
i,
Index: Integer;
BM : TBookMark;
S : String;
TL : TStringList;
begin
Memo1.Lines.Clear;
TL := TStringList.Create;
try
for i := 0 to cxGrid1DBTableView1.DataController.FilteredRecordCount - 1 do begin
Index := cxGrid1DBTableView1.DataController.FilteredRecordIndex[i];
V := cxGrid1DBTableView1.DataController.Values[Index, 0];
if cxGrid1DBTableView1.DataController.LocateByKey(V) then begin
if CDS1.FieldByName('Selected').AsBoolean then
S := 'True'
else
S := 'False';
S := CDS1.FieldByName('Name').AsString + ' ' + S;
Memo1.Lines.Add(S);
TL.Add(CDS1.FieldByName('Guid').AsString);
end;
end;
try
BM := CDS1.GetBookMark;
CDS1.DisableControls;
for i := 0 to TL.Count - 1 do begin
if CDS1.Locate('guid', TL[i], []) then begin
CDS1.Edit;
CDS1.FieldByName('Selected').AsBoolean := True;
CDS1.Post;
end
end;
finally
CDS1.EnableControls;
CDS1.GotoBookmark(BM);
CDS1.FreeBookmark(BM);
end;
finally
TL.Free;
end;
end;
Like you, I was expecting that changing a property or two of the cxGrid might avoid the problem without any code, but I haven't been able to find anything which does.
I implemented this code but again i am not able to search through the subdirectories .
procedure TFfileSearch.FileSearch(const dirName:string);
begin
//We write our search code here
if FindFirst(dirName,faAnyFile or faDirectory,searchResult)=0 then
begin
try
repeat
ShowMessage(IntToStr(searchResult.Attr));
if (searchResult.Attr and faDirectory)=0 then //The Result is a File
//begin
lbSearchResult.Items.Append(searchResult.Name)
else
begin
FileSearch(IncludeTrailingBackSlash(dirName)+searchResult.Name);
//
end;
until FindNext(searchResult)<>0
finally
FindClose(searchResult);
end;
end;
end;
procedure TFfileSearch.btnSearchClick(Sender: TObject);
var
filePath:string;
begin
lbSearchResult.Clear;
if Trim(edtMask.Text)='' then
MessageDlg('EMPTY INPUT', mtWarning, [mbOK], 0)
else
begin
filePath:=cbDirName.Text+ edtMask.Text;
ShowMessage(filePath);
FileSearch(filePath);
end;
end;
I am giving the search for *.ini files in E:\ drive. so initially filePath is E:*.ini.
But the code does not search the directories in E:\ drive. How to correct it?
Thanks in Advance
You can't apply a restriction to the file extension in the call to FindFirst. If you did so then directories do not get enumerated. Instead you must check for matching extension in your code. Try something like this:
procedure TMyForm.FileSearch(const dirName:string);
var
searchResult: TSearchRec;
begin
if FindFirst(dirName+'\*', faAnyFile, searchResult)=0 then begin
try
repeat
if (searchResult.Attr and faDirectory)=0 then begin
if SameText(ExtractFileExt(searchResult.Name), '.ini') then begin
lbSearchResult.Items.Append(IncludeTrailingBackSlash(dirName)+searchResult.Name);
end;
end else if (searchResult.Name<>'.') and (searchResult.Name<>'..') then begin
FileSearch(IncludeTrailingBackSlash(dirName)+searchResult.Name);
end;
until FindNext(searchResult)<>0
finally
FindClose(searchResult);
end;
end;
end;
procedure TMyForm.FormCreate(Sender: TObject);
begin
FileSearch('c:\windows');
end;
I'd recommend doing as follows:
uses
System.Types,
System.IOUtils;
procedure TForm7.Button1Click(Sender: TObject);
var
S: string;
begin
Memo1.Lines.Clear;
for S in TDirectory.GetFiles('C:\test', '*.bmp', TSearchOption.soAllDirectories) do
Memo1.Lines.Add(S);
Showmessage('Finished!');
end;
I hate those recursive solutions with FindFirst/FindNext and I consider it troublesome that some even forget to use FindClose to clean up resources. So, for the fun of it, a non-recursive solution that should be practical to use...
procedure FindDocs(const Root: string);
var
SearchRec: TSearchRec;
Folders: array of string;
Folder: string;
I: Integer;
Last: Integer;
begin
SetLength(Folders, 1);
Folders[0] := Root;
I := 0;
while (I < Length(Folders)) do
begin
Folder := IncludeTrailingBackslash(Folders[I]);
Inc(I);
{ Collect child folders first. }
if (FindFirst(Folder + '*.*', faDirectory, SearchRec) = 0) then
begin
repeat
if not ((SearchRec.Name = '.') or (SearchRec.Name = '..')) then
begin
Last := Length(Folders);
SetLength(Folders, Succ(Last));
Folders[Last] := Folder + SearchRec.Name;
end;
until (FindNext(SearchRec) <> 0);
FindClose(SearchRec);
end;
{ Collect files next.}
if (FindFirst(Folder + '*.doc', faAnyFile - faDirectory, SearchRec) = 0) then
begin
repeat
if not ((SearchRec.Attr and faDirectory) = faDirectory) then
begin
WriteLn(Folder, SearchRec.Name);
end;
until (FindNext(SearchRec) <> 0);
FindClose(SearchRec);
end;
end;
end;
While it seems to eat a lot of memory because it uses a dynamic array, a recursive method will do exactly the same but recursion happens on the stack! Also, with a recursive method, space is allocated for all local variables while my solution only allocates space for the folder names.
When you check for speed, both methods should be just as fast. The recursive method is easier to remember, though. You can also use a TStringList instead of a dynamic array, but I just like dynamic arrays.
One additional trick with my solution: It can search in multiple folders! I Initialized the Folders array with just one root, but you could easily set it's length to 3, and set Folders[0] to C:\, Folders[1] to D:\ and Folders[2] to E:\ and it will search on multiple disks!
Btw, replace the WriteLn() code with whatever logic you want to execute...
This is worked for me with multi-extension search support:
function GetFilesPro(const Path, Masks: string): TStringDynArray;
var
MaskArray: TStringDynArray;
Predicate: TDirectory.TFilterPredicate;
begin
MaskArray := SplitString(Masks, ',');
Predicate :=
function(const Path: string; const SearchRec: TSearchRec): Boolean
var
Mask: string;
begin
for Mask in MaskArray do
if MatchesMask(SearchRec.Name, Mask) then
exit(True);
exit(False);
end;
Result := TDirectory.GetFiles(Path, Predicate);
end;
Usage:
FileList := TStringList.Create;
FileSearch(s, '.txt;.tmp;.exe;.doc', FileList);
The problem with this file search is that it will loop infinitely, FindClose is like it does not exist.
procedure FindFilePattern(root:String;pattern:String);
var
SR:TSearchRec;
begin
root:=IncludeTrailingPathDelimiter(root);
if FindFirst(root+'*.*',faAnyFile,SR) = 0 then
begin
repeat
Application.ProcessMessages;
if ((SR.Attr and faDirectory) = SR.Attr ) and (pos('.',SR.Name)=0) then
FindFilePattern(root+SR.Name,pattern)
else
begin
if pos(pattern,SR.Name)>0 then Form1.ListBox1.Items.Add(Root+SR.Name);
end;
until FindNext(SR)<>0;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FindFilePattern('C:\','.exe');
end;
This searches recursively to all folders displaying filenames that contain a certain pattern.
Is there a feature in the Listview control to shift items up and down?
Not having worked with TListView very much (I mostly use database grids), I took your question as a chance to learn something. The following code is the result, it is more visually oriented that David's answer. It has some limitations: it will only move the first selected item, and while it moves the item, the display for vsIcon and vsSmallIcon is strange after the move.
procedure TForm1.btnDownClick(Sender: TObject);
var
Index: integer;
temp : TListItem;
begin
// use a button that cannot get focus, such as TSpeedButton
if ListView1.Focused then
if ListView1.SelCount>0 then
begin
Index := ListView1.Selected.Index;
if Index<ListView1.Items.Count then
begin
temp := ListView1.Items.Insert(Index+2);
temp.Assign(ListView1.Items.Item[Index]);
ListView1.Items.Delete(Index);
// fix display so moved item is selected/focused
ListView1.Selected := temp;
ListView1.ItemFocused := temp;
end;
end;
end;
procedure TForm1.btnUpClick(Sender: TObject);
var
Index: integer;
temp : TListItem;
begin
// use a button that cannot get focus, such as TSpeedButton
if ListView1.Focused then
if ListView1.SelCount>0 then
begin
Index := ListView1.Selected.Index;
if Index>0 then
begin
temp := ListView1.Items.Insert(Index-1);
temp.Assign(ListView1.Items.Item[Index+1]);
ListView1.Items.Delete(Index+1);
// fix display so moved item is selected/focused
ListView1.Selected := temp;
ListView1.ItemFocused := temp;
end;
end;
end;
You have two options:
Delete them and then re-insert them at the new location.
Use a virtual list view and move them in your data structure.
My routine for doing the first of these options is like this:
procedure TBatchTaskList.MoveTasks(const Source: array of TListItem; Target: TListItem);
var
i, InsertIndex: Integer;
begin
Assert(IsMainThread);
BeginUpdate;
Try
//work out where to move them
if Assigned(Target) then begin
InsertIndex := FListItems.IndexOf(Target);
end else begin
InsertIndex := FListItems.Count;
end;
//create new items for each moved task
for i := 0 to high(Source) do begin
SetListItemValues(
FListItems.Insert(InsertIndex+i),
TBatchTask(Source[i].Data)
);
Source[i].Data := nil;//handover ownership to the new item
end;
//set selection and focus item to give feedback about the move
for i := 0 to high(Source) do begin
FListItems[InsertIndex+i].Selected := Source[i].Selected;
end;
FBatchList.ItemFocused := FListItems[InsertIndex];
//delete the duplicate source tasks
for i := 0 to high(Source) do begin
Source[i].Delete;
end;
Finally
EndUpdate;
End;
end;
The method SetListItemValues is used to populate the columns of the list view.
This is a perfect example of why virtual controls are so great.
Is it possible to, for instance, replace and free a TEdit with a subclassed component instantiated (conditionally) at runtime? If so, how and when it should be done? I've tried to set the parent to nil and to call free() in the form constructor and AfterConstruction methods but in both cases I got a runtime error.
Being more specific, I got an Access violation error (EAccessViolation). It seems François is right when he says that freeing components at frame costruction messes with Form controls housekeeping.
This more generic routine works either with a Form or Frame (updated to use a subclass for the new control):
function ReplaceControlEx(AControl: TControl; const AControlClass: TControlClass; const ANewName: string; const IsFreed : Boolean = True): TControl;
begin
if AControl = nil then
begin
Result := nil;
Exit;
end;
Result := AControlClass.Create(AControl.Owner);
CloneProperties(AControl, Result);// copy all properties to new control
// Result.Left := AControl.Left; // or copy some properties manually...
// Result.Top := AControl.Top;
Result.Name := ANewName;
Result.Parent := AControl.Parent; // needed for the InsertControl & RemoveControl magic
if IsFreed then
FreeAndNil(AControl);
end;
function ReplaceControl(AControl: TControl; const ANewName: string; const IsFreed : Boolean = True): TControl;
begin
if AControl = nil then
Result := nil
else
Result := ReplaceControlEx(AControl, TControlClass(AControl.ClassType), ANewName, IsFreed);
end;
using this routine to pass the properties to the new control
procedure CloneProperties(const Source: TControl; const Dest: TControl);
var
ms: TMemoryStream;
OldName: string;
begin
OldName := Source.Name;
Source.Name := ''; // needed to avoid Name collision
try
ms := TMemoryStream.Create;
try
ms.WriteComponent(Source);
ms.Position := 0;
ms.ReadComponent(Dest);
finally
ms.Free;
end;
finally
Source.Name := OldName;
end;
end;
use it like:
procedure TFrame1.AfterConstruction;
var
I: Integer;
NewEdit: TMyEdit;
begin
inherited;
NewEdit := ReplaceControlEx(Edit1, TMyEdit, 'Edit2') as TMyEdit;
if Assigned(NewEdit) then
begin
NewEdit.Text := 'My Brand New Edit';
NewEdit.Author := 'Myself';
end;
for I:=0 to ControlCount-1 do
begin
ShowMessage(Controls[I].Name);
end;
end;
CAUTION: If you are doing this inside the AfterConstruction of the Frame, beware that the hosting Form construction is not finished yet.
Freeing Controls there, might cause a lot of problems as you're messing up with Form controls housekeeping.
See what you get if you try to read the new Edit Caption to display in the ShowMessage...
In that case you would want to use
...ReplaceControl(Edit1, 'Edit2', False)
and then do a
...FreeAndNil(Edit1)
later.
You have to call RemoveControl of the TEdit's parent to remove the control. Use InsertControl to add the new control.
var Edit2: TEdit;
begin
Edit2 := TEdit.Create(self);
Edit2.Left := Edit1.Left;
Edit2.Top := Edit2.Top;
Edit1.Parent.Insertcontrol(Edit2);
TWinControl(Edit1.parent).RemoveControl(Edit1);
Edit1.Free;
end;
Replace TEdit.Create to the class you want to use, and copy all properties you need like I did with Left and Top.
You can actually use RTTI (look in the TypInfo unit) to clone all the matching properties. I wrote code for this a while back, but I can't find it now. I'll keep looking.