How can I find an element by its tag and by specific attributes? This code I've written does find it by its tag, however it can't seem to find it by its attributes.
Why is there such behaviour with this code?
function FindElement(const Tag:String; const Attributes:TStringList):IHTMLElement;
var
FAttributeName, FAttributeValue:String;
Collection: IHTMLElementCollection;
E:IHTMLElement;
Count:Integer;
i, j:Integer;
begin
Collection := (EmbeddedWB1.Document as IHTMLDocument3).getElementsByTagName(Tag);
for i := 0 to Pred(Collection.length) do
begin
E := Collection.item(i, EmptyParam) as IHTMLElement;
for j := 0 to Attributes.Count-1 do
begin
FAttributeName:=LowerCase(List(Attributes,j,0,','));
FAttributeValue:=LowerCase(List(Attributes,j,1,','));
if not VarIsNull(E.getAttribute(FAttributeName,0)) then
begin
if (E.getAttribute(FAttributeName,0)=FAttributeValue) then
Inc(Count,1);
end;
if Count = Attributes.Count then
Exit(E);
end;
end;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
Attributes:TStringList;
begin
Attributes:=TStringList.Create;
Attributes.Add('id,something');
Attributes.Add('class,something');
FindElement('sometag',Attributes);
Attributes.Free;
end;
E := Collection.item(i, EmptyParam) as IHTMLElement;
// you should clear the value of matched attributes counter for each element
Count := 0;
for j := 0 to Attributes.Count-1 do
begin
P.S.
A little optimization:
if not VarIsNull(E.getAttribute(FAttributeName,0)) then
begin
if (E.getAttribute(FAttributeName,0)=FAttributeValue) then
Inc(Count,1);
end else
// if any of attributes of element is not found, you can skip to next element.
break;
Related
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 need to browse items of a treeview, without using recursion, for performance reasons.
TTreeview provides GlobalCount and ItemByGlobalIndex methods, but it only returns visible items
I searched the root class code without finding a private list of all nodes, FGlobalItems seems to only holds items that need to be rendered
Is there a way to sequentially browse all items (including not visible and collapsed nodes) of a treeview?
This question applies to Delphi XE3 / FM2
Thanks,
[Edit Feb 3]
I accepted the default answer (not possible out of the box), despite I was looking for a way to patch the firemonkey treeview on this aspect.
After more analysis, I found out that the FGlobalItems list only holds expanded items and is maintained in the method TCustomTreeView.UpdateGlobalIndexes;
Commenting line 924 of FMX.TreeView (if AItem.IsExpanded then...) leads to building a full index of nodes, and allows to browse all nodes sequentially using ItemByGlobalIndex(), BUT could lead to other performance issues and bugs...Without any more clue, I'll keep my recursive code.
Here are my functions for walking a treeview in a non-recursive manner. Simple to use if you have a node and want to move to the next or previous one without having to walk the entire tree.
GetNextItem functions by looking at it's first child, or if no children, looking at it's parent for the next child after itself (and going further through parents as necessary).
GetPrevItem looks at the parent to find the previous item, and uses GetLastChild to find the last child of that item (which does use recursion, BTW).
Note that the code as written only walk Expanded nodes, but can easily be modified to walk all nodes (just remove references to IsExpanded).
function GetLastChild(Item: TTreeViewItem): TTreeViewItem;
begin
if (Item.IsExpanded) and (Item.Count > 0) then
Result := GetLastChild(Item.Items[Item.Count-1])
else
Result := Item;
end;
function GetNextItem(Item: TTreeViewItem): TTreeViewItem;
var ItemParent: TTreeViewItem;
I: Integer;
TreeViewParent: TTreeView;
Parent: TFMXObject;
Child: TFMXObject;
begin
if Item = nil then
Result := nil
else if (Item.IsExpanded) and (Item.Count > 0) then
Result := Item.Items[0]
else
begin
Parent := Item.Parent;
Child := Item;
while (Parent <> nil) and not (Parent is TTreeView) do
begin
while (Parent <> nil) and not (Parent is TTreeView) and not (Parent is TTreeViewItem) do
Parent := Parent.Parent;
if (Parent <> nil) and (Parent is TTreeViewItem) then
begin
ItemParent := TTreeViewItem(Parent);
I := 0;
while (I < ItemParent.Count) and (ItemParent.Items[I] <> Child) do
inc(I);
inc(I);
if I < ItemParent.Count then
begin
Result := ItemParent.Items[I];
EXIT;
end;
Child := Parent;
Parent := Parent.Parent
end;
end;
if (Parent <> nil) and (Parent is TTreeView) then
begin
TreeViewParent := TTreeView(Parent);
I := 0;
while (I < TreeViewParent.Count) and (TreeViewParent.Items[I] <> Item) do
inc(I);
inc(I);
if I < TreeViewParent.Count then
Result := TreeViewParent.Items[I]
else
begin
Result := Item;
EXIT;
end;
end
else
Result := Item
end
end;
function GetPrevItem(Item: TTreeViewItem): TTreeViewItem;
var Parent: TFMXObject;
ItemParent: TTreeViewItem;
TreeViewParent: TTreeView;
I: Integer;
begin
if Item = nil then
Result := nil
else
begin
Parent := Item.Parent;
while (Parent <> nil) and not (Parent is TTreeViewItem) and not (Parent is TTreeView) do
Parent := Parent.Parent;
if (Parent <> nil) and (Parent is TTreeViewItem) then
begin
ItemParent := TTreeViewItem(Parent);
I := 0;
while (I < ItemParent.Count) and (ItemParent.Items[I] <> Item) do
inc(I);
dec(I);
if I >= 0 then
Result := GetLastChild(ItemParent.Items[I])
else
Result := ItemParent;
end
else if (Parent <> nil) and (Parent is TTreeView) then
begin
TreeViewParent := TTreeView(Parent);
I := 0;
while (I < TreeViewParent.Count) and (TreeViewParent.Items[I] <> Item) do
inc(I);
dec(I);
if I >= 0 then
Result := GetLastChild(TreeViewParent.Items[I])
else
Result := Item
end
else
Result := Item;
end;
end;
The question essentially asks how to traverse a tree without recursion. There are many ways to traverse a tree; the fact that your tree happens to be represented with nodes in a visual control is irrelevant.
For some algorithms, it's easier to think of the traversal in recursive terms. That way, you let the programming language keep track of where in the tree you are by keeping the currently active node as an argument on the stack. If you don't want to use recursion, then you simply have to keep track of the progress yourself. Common tools for that include stacks and queues.
A preorder traversal means that when you visit a node, you do your action on that node's data before doing the action on the node's children. It corresponds to visiting each node of a tree-view control from top to bottom. You could implement it like this with a stack:
procedure PreorderVisit(Node: TTreeNode; Action: TNodeAction);
var
Worklist: TStack<TTreeNode>;
i: Integer;
begin
Worklist := TStack<TTreeNode>.Create;
try
Worklist.Push(Node);
repeat
Node := Worklist.Pop;
for i := Pred(Node.Items.Count) downto 0 do
Worklist.Push(Node.Items[i]);
Action(Node);
until Worklist.Empty;
finally
Worklist.Free;
end;
end;
Push the children onto the stack in reverse order so they'll be popped off in the desired order.
In that code, Action stands for whatever task you need to do with each node. You can either use it as specified in the code, as an external function, or you can write a specialized version of PreorderVisit that includes the task-specific code.
TTreeView doesn't actually represent a tree, though. It's really a forest (a collection of trees). That's because there is no single node that represents the root. You can easily use the function above to process all the nodes in a tree, though:
procedure PreorderVisitTree(Tree: TTreeView; Action: TNodeAction);
var
i: Integer;
begin
for i := 0 to Pred(Tree.Items.Count) do
PreorderVisit(Tree.Items[i], Action);
end;
Another way of doing a preorder traversal that takes advantage of the specific structure of TTreeView is to use the built-in GetNext method of each node:
procedure PreorderVisitTree(Tree: TTreeView; Action: TNodeAction);
var
Node: TTreeNode;
begin
if Tree.Items.Count = 0 then
exit;
Node := Tree.Items[0];
repeat
Action(Node);
Node := Node.GetNext;
until not Assigned(Node);
end;
There appears to be no way of getting hidden nodes of a Firemonkey tree view. You might find better results by iterating over your internal tree data structure instead of trying to extract information from the GUI.
In XE8 this works for me:
function GetNextItem(Item: TTreeViewItem): TTreeViewItem;
var
Parent: TFMXObject;
Child: TTreeViewItem;
begin
Result := nil;
if Item.Count > 0 then
Result := Item.Items[0]
else
begin
Parent := Item.ParentItem;
Child := Item;
while (Result = nil) and (Parent <> nil) do
begin
if Parent is TTreeViewItem then
begin
if TTreeViewItem(Parent).Count > (Child.Index + 1) then
Result := TTreeViewItem(Parent).Items[Child.Index + 1]
else
begin
Child := TTreeViewItem(Parent);
if Child.ParentItem <> nil then
Parent := Child.ParentItem
else
Parent := Child.TreeView;
end;
end
else
begin
if TTreeView(Parent).Count > Child.Index + 1 then
Result := TTreeView(Parent).Items[Child.Index + 1]
else
Parent := nil;
end;
end;
end;
end;
The Item.ParentItem can also be nil! That is why I had replaced the line Parent := Item.ParentItem with the following lines:
if Item.ParentItem <> nil then
Parent := Item.ParentItem
else
Parent := Item.TreeView;
The complete function GetNextItem after the correction:
function GetNextItem(Item: TTreeViewItem): TTreeViewItem;
var
Parent: TFMXObject;
Child: TTreeViewItem;
begin
Result := nil;
if Item.Count > 0 then
Result := Item.Items[0]
else begin
if Item.ParentItem <> nil then
Parent := Item.ParentItem
else
Parent := Item.TreeView;
Child := Item;
while (Result = nil) and (Parent <> nil) do
begin
if Parent is TTreeViewItem then
begin
if TTreeViewItem(Parent).Count > (Child.Index + 1) then
Result := TTreeViewItem(Parent).Items[Child.Index + 1]
else begin
Child := TTreeViewItem(Parent);
if Child.ParentItem <> nil then
Parent := Child.ParentItem
else
Parent := Child.TreeView;
end;
end else begin
if TTreeView(Parent).Count > Child.Index + 1 then
Result := TTreeView(Parent).Items[Child.Index + 1]
else
Parent := nil;
end;
end;
end;
end;
Tested at Delphi 10.3.2
I would add a function to SEARCH PARTIALLY a text into a TreeView, from a TEdit (Search) placed up from the TreeView (TV). (special thank to the previous post which this answer is based from)
This work perfectly using Enter to start the search and F3 to continue searching.
// SEARCH ITEM (text partially or by particular ID in item.tag)
function GetNextItem(Item: TTreeViewItem): TTreeViewItem;
var
Parent: TFMXObject;
Child: TTreeViewItem;
begin
Result := nil;
if Item.Count > 0 then
Result := Item.Items[0]
else begin
if Item.ParentItem <> nil then
Parent := Item.ParentItem
else
Parent := Item.TreeView;
Child := Item;
while (Result = nil) and (Parent <> nil) do
begin
if Parent is TTreeViewItem then
begin
if TTreeViewItem(Parent).Count > (Child.Index + 1) then
Result := TTreeViewItem(Parent).Items[Child.Index + 1]
else begin
Child := TTreeViewItem(Parent);
if Child.ParentItem <> nil then
Parent := Child.ParentItem
else
Parent := Child.TreeView;
end;
end else begin
if TTreeView(Parent).Count > Child.Index + 1 then
Result := TTreeView(Parent).Items[Child.Index + 1]
else
Parent := nil;
end;
end;
end;
end;
function FindItem(aFromItem : TTreeViewItem ; Value: String = '' ; aID : integer = -1) : TTreeViewItem;
var I: Integer;
begin
Result := nil;
while aFromItem.Index < aFromITem.TreeView.Count do
begin
aFromItem := GetNextItem(aFromItem);
if aFromItem <> nil then
begin
if (aID <> -1) and (aFromItem.Tag = aID) then
begin
Result := aFromItem;
EXIT;
end
else if pos(Value, uppercase(aFromItem.Text)) > 0 then
begin
Result := aFromItem;
EXIT;
end;
end
else
exit;
end;
end;
procedure TCListeMedia.SearchKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
var
i : integer;
vSearch : string;
begin
if (Key = 13) or (Key = vkF3) then
begin
// Search or continue to search
vSearch := Uppercase(Search.Text);
if Key = 13 then
begin
i := 0;
if TV.Count > 0 then
begin
if pos(vSearch, uppercase(TV.Items[0].Text)) > 0 then
TV.Selected := TV.Items[0]
else
TV.Selected := FindItem(TV.Items[0], vSearch);
end;
end
else if TV.Selected <> nil then
begin
i := 1 + TV.Selected.Index;
TV.Selected := FindItem(TV.Selected, vSearch);
end;
end;
end;
procedure TCListeMedia.TVKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
begin
if (Key = vkF3) then
SearchKeyDown(Sender, Key, KeyChar, Shift);
end;
I have made this function for my project is fast and easy you can try it
function FindItem(const TreeView: TTreeView; const Value: Variant): TTreeViewItem;
function ItemExist(const AItem: TTreeViewItem): Boolean;
begin
Result:= False;
if AItem <> nil then
begin
{Set your condition here}
if AItem.Text = Value then
begin
FindItem:= AItem;
Exit(True);
end;
var I: Integer;
for I := 0 to AItem.Count - 1 do
begin
if ItemExist( AItem.ItemByIndex(I)) then
Break;
end;
end;
end;
var
AItem: TTreeViewItem;
I: Integer;
begin
Result:= nil;
for I := 0 to TreeView.Count - 1 do
begin
AItem:= TreeView.ItemByIndex(I);
if ItemExist(AItem) or (Result <> nil) then Break;
end;
end;
I take advantage of class helpers and anonymous procedures in Delphi to loop through items in a TreeView. This can be easilly extended to build an index list.
My class helper goes like this:
{ TTreeViewHelper }
TTreeViewHelper
= Class helper for FMX.TreeView.TTreeView
Public
Procedure LoopThroughItems(const Func: TProc<TTreeViewItem>; const AExpandedOnly: Boolean);
End;
Procedure TTreeViewHelper.LoopThroughItems(const Func: TProc<TTreeViewItem>; const AExpandedOnly: Boolean);
var
i : integer;
procedure ProcessItem(const AItem: TTreeViewItem);
var
I: Integer;
begin
if(AItem=nil) then exit;
Func(AItem);
for I := 0 to AItem.Count - 1 do ProcessItem(AItem.ItemByIndex(I));
end;
begin
if not Assigned(Func)then exit;
if(GlobalCount<1)then exit;
if(AExpandedOnly)
then for i:=0 to Count-1 do Func(self.Items[i])
else for i:=0 to Count-1 do ProcessItem(ItemByGlobalIndex(i));
end;
And I am using it like this:
TreeView1.LoopThroughItems(
procedure(E: TTreeViewItem)
begin
if Assigned(E)and(E is TTreeNode)
then TN := E as TTreeNode { My own subclass }
else exit;
if Assigned(TN.DataObject)and(TN.DataObject is TIOTSensorData)
then IOT := TN.DataObject as TIOTSensorData
else exit;
if(IOT<>AFormula)then exit;
TreeView1.Selected := TN;
end,
False
);
The sample above is from my actual project, you would use your own logic in the anonymous procedure, but the really neat part is the last TreeView1.Selected := TN;, becasue even if the TN is a non-visible item, the TreeView will select it and expand all its parent nodes.
Now, you say you want to avoid recursion, but actually you want to avoid a recursive recursion. Because you'll have to build your index first, and while building it is okay to use recursion one time in there.
Following the same approach, just go ahead and add a new method to your class helper:
{ TTreeViewHelper }
TTreeViewHelper
= Class helper for FMX.TreeView.TTreeView
Public
Procedure LoopThroughItems(const Func: TProc<TTreeViewItem>; const AExpandedOnly: Boolean);
Function BuildFullIndex: TList<TTreeViewItem>;
End;
Function TTreeViewHelper.BuildFullIndex: TList<TTreeViewItem>;
var
i : integer;
procedure Publish(const AItem: TTreeViewItem);
var
I: Integer;
begin
if(AItem=nil) then exit;
Result.Add(AItem);
for I := 0 to AItem.Count - 1 do Publish(AItem.ItemByIndex(I));
end;
begin
Result := TList<TTreeViewItem>.Create;
if(GlobalCount<1)then exit;
for i:=0 to Count-1 do Publish(ItemByGlobalIndex(i))
end;
And use it like this:
uses
System.Generics.Collections;
var
Index : TList<TTreeViewItem>;
begin
Index := Formulas.BuildFullIndex;
try
if(Index.Count<1)then exit;
for i:=0 to Index.Count-1 do
begin
{ do your thing here }
end;
finally
FreeAndNil(Index);
end;
end;
Cheers!
I am pretty "green" at programming and I've to bring assignment tomorrow. It is almost complete but there is a slight problem. I cannot remove the first element and if after trying to delete first element I input
a new one in its place mmm.... lets just say I input infinitely many of them instead. I cant seem to find what is the problem. Thanks in advance
program dvipsar;
type duomenys = integer;
sarasas = ^elementas;
elementas = record
info: duomenys;
anks: sarasas;
tolsn: sarasas
end;
procedure sukurtiTuscia(var s: sarasas); {creates empty list}
begin
s := nil
end;
function tuscias(s: sarasas): boolean; {checks if list is empty}
begin
tuscias := s = nil
end;
function elmSk(s: sarasas): integer; {counts elements}
var kiek: integer;
begin
kiek := 0;
while s <> nil do
begin
kiek := kiek + 1;
s := s^.tolsn
end;
elmSk := kiek
end;
function gautiRodN(s: sarasas; n:integer): sarasas; {Arrow to n-th element}
var i: integer;
begin
i := 1;
while (s <> nil) and (i<n) do
begin
i := i + 1;
s := s^.tolsn
end;
if i = n then gautiRodN := s
else gautiRodN := nil
end;
function gautiN(s: sarasas; n:integer): duomenys; {gets n-th element data}
var elem: sarasas;
begin
elem := gautiRodN(s,n);
if elem <> nil then gautiN := elem^.info
end;
procedure iterptiPries(s:sarasas; n: integer; duom: duomenys); {adds new element before n-th element}
var nElem: sarasas;
naujas: sarasas;
begin
nElem := gautiRodN(s,n);
if nElem <> nil then begin
new (naujas);
naujas^.info := duom;
naujas^.tolsn := nElem;
naujas^.anks := nElem^.anks;
if nElem^.anks <> nil then nElem^.anks^.tolsn := naujas;
nElem^.anks := naujas;
end
end;
procedure panaikintiN(s: sarasas; n: integer); {removes element from n-th place}
var nElem: sarasas;
begin
nElem := gautiRodN(s,n);
if nElem <> nil then begin
if nElem^.anks <> nil then nElem^.anks^.tolsn := nElem^.tolsn;
if nElem^.tolsn <> nil then nElem^.tolsn^.anks := nElem^.anks;
dispose(nElem);
end;
end;
function rasti(s: sarasas; duom: duomenys): sarasas; {finds element}
begin
while (s <> nil) and (s^.info <> duom) do s := s^.tolsn;
rasti := s
end;
procedure spausdinti(s: sarasas); {prints list}
begin
while (s <> nil) do begin
write(s^.info,' ');
s := s^.tolsn
end;
writeln
end;
procedure panaikintiP(var s: sarasas); {removes first element}
var pirmas: sarasas;
begin
pirmas := s;
s := s^.tolsn;
dispose (pirmas)
end;
procedure panaikinti(var s: sarasas); {deletes list}
begin
while s <> nil do panaikintiP(s)
end;
procedure prideti(var s: sarasas; duom: duomenys); {add element at the end of the list}
var kiek: integer;
paskutinis,naujas: sarasas;
begin
kiek := elmSk(s);
paskutinis := gautiRodN(s,kiek);
new(naujas);
naujas^.info := duom;
naujas^.tolsn := nil;
naujas^.anks := paskutinis;
if paskutinis <> nil then paskutinis^.tolsn := naujas
else s := naujas
end;
procedure menu;
begin
writeln;
writeln;
writeln ('1 Creat a list');
writeln ('2 Count the elements');
writeln ('3 Check if list is empty');
writeln ('4 Print an element');
writeln ('5 Print the list');
writeln ('6 Remove an element')
writeln ('7 Add an element');
writeln ('8 Search in the list');
writeln;
writeln ('0 End');
writeln;
writeln;
end;
var s: sarasas;
i,j: integer;
t: sarasas;
c: char;
veiksmas: integer;
begin
sukurtiTuscia(s);
repeat
menu;
write('Input action number : ');
readln(veiksmas);
case veiksmas of
1:
repeat
write('input a number which you want to add to the list: ');
readln(i);
prideti(s,i);
write('Add new number? (t/n)? ');
read(c);
until (c='N') or (c='n');
2: writeln ('List is not empty: ',elmSk(s));
3: if tuscias(s) then writeln ('List is empty')
else writeln ('List is not empty');
4: begin
write ('Which element to print?: ');
readln(i);
writeln(i,'-th list element?: ',gautiN(s,i));
end;
5: spausdinti(s);
6: begin
write ('which element to remove?: ');
readln(i);
panaikintiN(s,i);
end;
7:begin
write ('What to add to the list?: ');
readln(i);
write ('Before which element?: ');
readln(j);
iterptiPries(s,j,i);
end;
8: begin
write ('What element to look for?: ');
readln(i);
t := rasti(s,i);
if t <> nil then writeln (i, ' exists in the list')
else writeln (i, ' does not exists in the list');
end;
0: writeln ('Ending');
else writeln('Incorrect action');
end;
until veiksmas = 0;
panaikinti(s); {deletes list}
end.
http://en.wikipedia.org/wiki/Doubly_linked_list#Removing_a_node
Removal of a node is easier than insertion, but requires special handling if the node to be removed is the firstNode or lastNode:
function remove(List list, Node node)
if node.prev == null
list.firstNode := node.next
else
node.prev.next := node.next
if node.next == null
list.lastNode := node.prev
else
node.next.prev := node.prev
destroy node
One subtle consequence of the above procedure is that deleting the last node of a list sets both firstNode and lastNode to null, and so it handles removing the last node from a one-element list correctly.
Notice that we also don't need separate "removeBefore" or "removeAfter" methods, because in a doubly linked list we can just use "remove(node.prev)" or "remove(node.next)" where these are valid.
This also assumes that the node being removed is guaranteed to exist.
If the node does not exist in this list, then some error handling would be required.
I am trying to find out which form and element belongs too. The code that I now understand from this website:
http://www.cryer.co.uk/brian/delphi/twebbrowser/read_write_form_elements.htm
containing this code
function GetFormFieldNames(fromForm: IHTMLFormElement): TStringList;
var
index: integer;
field: IHTMLElement;
input: IHTMLInputElement;
select: IHTMLSelectElement;
text: IHTMLTextAreaElement;
begin
result := TStringList.Create;
for index := 0 to fromForm.length do
begin
field := fromForm.Item(index,'') as IHTMLElement;
if Assigned(field) then
begin
if field.tagName = 'INPUT' then
begin
// Input field.
input := field as IHTMLInputElement;
result.Add(input.name);
end
else if field.tagName = 'SELECT' then
begin
// Select field.
select := field as IHTMLSelectElement;
result.Add(select.name);
end
else if field.tagName = 'TEXTAREA' then
begin
// TextArea field.
text := field as IHTMLTextAreaElement;
result.Add(text.name);
end;
end;
end;
end;
seems to be working fine for most sites. However there are a few websites such as this one:
http://service.mail.com/registration.html#.1258-bluestripe-product1-undef
By looking at that code and comparing it with the active id, I can find the form it is in. However it does not work for that website. for some reason I think it has to do with htmldocument3 adn that this code is for htmldocument2. But I am not sure.
so my question is How can I extract a tstringlist from this website with all the elements names in them? hope you can help!
Edited: Added some code
begin
theForm := GetFormByNumber(webbrowser1.document as IHTMLDocument2,
0);
fields := GetFormFieldNames(theForm);
num := fields.IndexOf(theid);
end;
until (num <> -1);
One complication with locating form elements in a web page is that the page may contain frames and there may be forms in any of the frames. Basically, you have to iterate through all the frames and the forms in each frame. Once you get the form as an IHTMLFormElement, use Cryer's function to get the form element names.
The example link you gave does not have any frames and you should have had no problems getting your list of form elements, unless you tried to get the form by name because it had no name assigned. I had no problem getting the form element names and values using the following procedure
procedure GetForms(doc1: IHTMLDocument2; var sl: TStringList);
var
i, j, n: integer;
docForm: IHTMLFormElement;
slt: TStringList;
s: string;
begin
if doc1 = nil then
begin
ShowMessage('doc1 is empty [GetForms]');
Exit;
end;
slt := TStringList.Create;
n := NumberOfForms(doc1);
sl.Add('Forms: ' + IntToStr(n));
for i := 0 to n - 1 do
begin
docForm := GetFormByNumber(doc1, i);
sl.Add('Form Name: ' + docForm.Name);
slt.Clear;
slt := GetFormFieldNames(docForm);
for j := 0 to slt.Count - 1 do
begin
s := GetFieldValue(docForm, slt[j]);
sl.Add('Field Name: ' + slt[j] + ' value: "' + s + '"');
end;
end;
sl.Add('');
slt.Free;
end;
Cryer's example for navigating a frameset will not work for all web sites, see http://support.microsoft.com/support/kb/articles/Q196/3/40.ASP. The following function successfuly extracts a frame as an IHTMLDocument2 on all sites I have tried
function GetFrameByNumber(Doc:IHTMLDocument2; n:integer):IHTMLDocument2;
var
Container: IOleContainer;
Enumerator: ActiveX.IEnumUnknown;
Unknown: IUnknown;
Browser: IWebBrowser2;
Fetched: Longint;
NewDoc: IHTMLDocument2;
i : integer;
begin
// We cannot use the document's frames collection here, because
// it does not work in every case (i.e. Documents from a foreign domain).
// From: http://support.microsoft.com/support/kb/articles/Q196/3/40.ASP
i := 0;
if (Supports(Doc, IOleContainer, Container)) and
(Container.EnumObjects(OLECONTF_EMBEDDINGS, Enumerator) = S_OK) then
begin
while Enumerator.Next(1, Unknown, #Fetched) = S_OK do
begin
if (Supports(Unknown, IWebBrowser2, Browser)) and
(Supports(Browser.Document, IHTMLDocument2, NewDoc)) then
begin
// Here, NewDoc is an IHTMLDocument2 that you can query for
// all the links, text edits, etc.
if i=n then
begin
Result := NewDoc;
Exit;
end;
i := i+1;
end;
end;
end;
end;
Here is an example of how I have used GetForms and GetFrameByNumber
// from the TForm1 declaration
{ Public declarations }
wdoc: IHTMLDocument2;
procedure TForm1.btnAnalyzeClick(Sender: TObject);
begin
wdoc := WebBrowser.Document as IHTMLDocument2;
GetDoc(wdoc);
end;
procedure TForm1.GetDoc(doc1: IHTMLDocument2);
var
i, n: integer;
doc2: IHTMLDocument2;
frame_dispatch: IDispatch;
frame_win: IHTMLWindow2;
ole_index: olevariant;
sl: TStringList;
begin
if doc1 = nil then
begin
ShowMessage('Web doc is empty');
Exit;
end;
Form2.Memo1.Lines.Clear;
sl := TStringList.Create;
n := doc1.frames.length;
sl.Add('Frames: ' + IntToStr(n));
// check each frame for the data
if n = 0 then
GetForms(doc1, sl)
else
for i := 0 to n - 1 do
begin
sl.Add('--Frame: ' + IntToStr(i));
ole_index := i;
frame_dispatch := doc1.Frames.Item(ole_index);
if frame_dispatch <> nil then
begin
frame_win := frame_dispatch as IHTMLWindow2;
doc2 := frame_win.document;
// sl.Add(doc2.body.outerHTML);
GetForms(doc2,sl);
GetDoc(doc2);
end;
end;
// Form2 just contains a TMemo
Form2.Memo1.Lines.AddStrings(sl);
Form2.Show;
sl.Free;
end;
The logic in your example is faulty, 1. when there is only 1 form on the web page the list of form elements is never extracted, 2. the repeat loop will result in a access violation unless the the tag in "theid" is found
Here is your example cut down to successfully extract the form elements.
var
i : integer;
nforms : integer;
document : IHTMLDocument2;
theForm : IHTMLFormElement;
fields : TStringList;
theform1 : integer;
num : integer;
theid : string;
begin
fields := TStringList.Create;
theid := 'xx';
// original code follows
i := -1;
// nforms := NumberOfForms(webbrowser1.document as IHTMLDocument2);
// document := webbrowser1.document as IHTMLDocument2;
// if nforms = 1 then
// begin
// theForm := GetFormByNumber(webbrowser1.document as IHTMLDocument2, 0);
// theform1 := 0;
// end
// else
begin
// repeat
begin
inc(i);
theForm := GetFormByNumber(webbrowser1.document as IHTMLDocument2,
i);
fields := GetFormFieldNames(theForm);
num := fields.IndexOf(theid);
theform1 := i;
end;
// until (num <> -1);
end;
// end of original code
Memo1.Lines.Text := fields.Text;
fields.Free;
end;
Hm, are you sure this link contains any form elements? At least I did not see any visible ones. Perhaps they are hidden - did not check this myself, however.
Michael
how can I find by name and get the Item in a collection of object ?
procedure TfoMain.InitForm;
begin
// Liste des produits de la pharmacie 1
FListeDispoProduit := TListeDispoProduit.Create(TProduit);
with (FListeDispoProduit) do
begin
with TProduit(Add) do
begin
Name := 'Produit 01';
CIP := 'A001';
StockQty := 3;
AutoRestock := 1;
QtyMin:= 2;
end;
with TProduit(Add) do
begin
Name := 'Produit 02';
CIP := 'A002';
StockQty := 5;
AutoRestock := 0;
QtyMin:= 2;
end;
function getProductByName(productName: String): TProduit;
var
i : integer;
begin
for i := 0 to fProductList.Count -1 do
begin
if (TProduit(fProductList.Items[i]).Name = productName)
Result :=
end;
end;
I want to edit qty about a product name.
How can I do this?
thank you
If your collection object is a TCollection, then it has an Items property (which you should have been about to see in the documentation, or in the source code). Use that and its Count property to write a loop where you inspect each item to see whether it matches your target.
var
i: Integer;
begin
for i := 0 to Pred(FListeDespoProduit.Count) do begin
if TProduit(FListeDespoProduit.Items[i]).Name = productName then begin
Result := TProduit(FListeDespoProduit.Items[i]);
exit;
end;
end;
raise EItemNotFound.Create;
end;
Items is a default property, which means you can omit it from your code and just use the array index by itself. Instead of FListeDespoProduit.Items[i], you can shorten it to just FListeDespoProduit[i].
function getProductByName(productName: String): TProduit;
var
i : integer;
begin
for i := 0 to fProductList.Count -1 do
begin
if (TProduit(fProductList.Items[i]).Name = productName)
Result := TProduit(fProductList.Items[i]); // this???
end;
end;
You can then go:
MyProduit := getProductByName('banana');
MyProduit.StockQty := 3;
Or whatever you wish.
Your TProduit implements (Add). It doesn't already implement (Get) (or something similar)?
Are you inheriting this code? Is there more detail?
Edit: otherwise you'll have to create the Get procedure yourself, possibly by looping over the list and finding a match, then returning it.