Delphi L oop a tcxtreeList для проверки и отмены проверки узлов в зависимости от значений ключа из строки

Question

Я довольно новичок в delphi разработке, у меня есть собственный компонент CheckTreeList, унаследованный от компонента cxTreeList Dev express. Когда я проверяю некоторые узлы в списке, эти значения сохраняются в строку в формате, как показано ниже Формат строки для выбранных узлов в виде изображения Проблема в том, что я не могу проверить узлы контрольного списка с помощью цикл по узлам и значениям в строке. Я попробовал приведенный ниже код для сохранения и загрузки отмеченных и непроверенных узлов. Сохранение значений ключей проверенных узлов в строку работает, но загрузка узлов и их проверка не работает. Ниже приведен исходный код компонента

unit DXCheckTreelist;

interface

uses
  System.Classes, cxTL, cxLookAndFeelPainters;

type

  TdxUnboundTreeListNode = class(TcxUnboundTreeListNode)

  protected
    procedure SetCheckState(AValue: TcxCheckBoxState); override;
  end;

  TdxCheckTreeList = class(TcxTreeList)
  Private
    FEnableStdTreebehaviour : Boolean;
  protected
    function CreateNode: TcxTreeListNode; override;
  Published
    Property EnableStdTreebehaviour: Boolean read FEnableStdTreebehaviour write FEnableStdTreebehaviour default False;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('DX Components', [TdxCheckTreeList]);
end;
{ TdxCheckTreeList }    
function TdxCheckTreeList.CreateNode: TcxTreeListNode;
begin
  Result := TdxUnboundTreeListNode.Create(Self);
  Changes := Changes + [tcStructure];
end;

{ TdxUnboundTreeListNode }

procedure TdxUnboundTreeListNode.SetCheckState(AValue: TcxCheckBoxState);
var
  ParentNode : TdxUnboundTreeListNode;
  PrevCheckState: TcxCheckBoxState;
const
  AState: array[TcxCheckBoxState] of TcxTreeListNodeCheckInfos = ([], [nciChecked], [nciGrayed]);
  AParentCheckState: array[Boolean] of TcxCheckBoxState = (cbsGrayed, cbsChecked);
begin

  if  TdxCheckTreeList(TreeList).FEnableStdTreebehaviour then
  begin
    inherited;
    Exit;
  end;

  if not CanChecked then
  begin
    State := State - [nsCheckStateInvalid];
    Exit;
  end;

  PrevCheckState := CheckState;
  CheckInfo := CheckInfo - [nciChecked, nciGrayed] + AState[AValue] + [nciChangeCheck];


  try
    if (CheckState in [cbsChecked, cbsUnchecked]) and HasChildren then
    begin
      LoadChildren;

      if AValue = cbsUnchecked then
        SetChildrenCheckState(CheckState, nil);
    end;

    ParentNode := TdxUnboundTreeListNode(Parent);

    if ParentNode <> nil then
    begin
      if ParentNode.IsRadioGroup and Checked then
        ParentNode.SetChildrenCheckState(cbsUnchecked, Self);

      if not (nciChangeCheck in ParentNode.CheckInfo) and (ParentNode <> Root) then
        ParentNode.CheckState := cbsChecked;
    end;
  finally
    CheckInfo := CheckInfo - [nciChangeCheck];
    State := State - [nsCheckStateInvalid];

    if CanChecked then
      Repaint(True);

    if (PrevCheckState <> CheckState) and Assigned(TcxTreeList(TreeList).OnNodeCheckChanged) then
      TcxTreeList(TreeList).OnNodeCheckChanged(TreeList, Self, CheckState);
  end;
end;
end.

. В моем случае для свойства EnableStdTreebehaviour установлено значение true.

Код для сохранения значений выбранного ключа узла:

procedure TfrmTreeList.btnSaveDataClick(Sender: TObject);
var
  I, J: Integer;
  node, cnode: TcxTreeListNode;
  Result: String;
begin
  result:= '';
  for i := 0 to ctvMandatory.Count - 1 do
  begin
    node := TcxTreeListNode(ctvMandatory.Items[i]);
    if ctvMandatory.Items[i].CheckState in [cbsChecked, cbsGrayed] then
    begin
      if node.Level = 0 then Result:= Result + '[' + node.Values[1] + ']' + ',';

      for J := 0 to ctvMandatory.Items[i].Count - 1 do
      begin
        cnode := ctvMandatory.Items[i].Items[J];
        if (cnode.Checked) and (cnode.Level = 1) then
        begin
          Result:= Result + cnode.Values[2] + ',';
        end;
      end;
    end;
  end;

  if (Result <> '') and (Result[Length(result)] = ',') then
        result:= Copy(Result, 1, length(Result) -1 );
  Memo.Clear;

  if result <> '' then
  begin
    Memo.Lines.Add(Trim(Result));
    csv := result;
  end;
  for i := 0 to ctvMandatory.count - 1 do
  begin
    node := TcxTreeListNode(ctvMandatory.Items[i]);
    ctvMandatory.Items[i].Checked := False;
  end;
end;

Код, который я пытался загрузить и проверить узел, зависит от значения ключа из строки:

procedure TfrmTreeList.btnLoadDataClick(Sender: TObject);
var
  i, j, X: integer;
  node, cnode: TcxTreeListNode;
  sl,s2: TStringList;
  str: string;
  key, value, val: string;
begin
  chbAll.Checked:= csv = 'All';
  ctvMandatory.BeginUpdate;
  if chbAll.Checked then
  begin
  for i:= 0 to ctvMandatory.AbsoluteCount - 1 do
    ctvMandatory.Items[I].Checked := True;
    ctvMandatory.EndUpdate;
    SetMandatoryText;
    Exit;
  end;

  for i:= 0 to ctvMandatory.Count - 1 do
    ctvMandatory.Items[I].Checked := False;

  if csv = 'All' then
  begin
    for i:= 0 to ctvMandatory.AbsoluteCount - 1 do
      ctvMandatory.Items[I].Checked := True;
  end
  else
  if (length(csv) > 0) and (Pos(']', csv) = 0) then
  begin
    for i := 0 to ctvMandatory.Count - 1 do
    begin
      node:= TcxTreeListNode(ctvMandatory.Items[i]);
      if node.Level = 0 then
        ctvMandatory.Items[i].Checked:= True
      else
      if (node.Level = 1) and IsValueInCSV(csv, node.Values[1])  then
      begin
        ctvMandatory.Items[i].Checked := True;
      end;
    end;
  end
  else
  begin
   sl:= TStringList.Create;
   sl.Delimiter:= ',';
   sl.DelimitedText:= csv;
   node:= nil;
   s2:= TStringList.Create;
   s2.Delimiter:= ',';
   for str in sl do
   begin
     if (pos('[', str) > 0) then
     begin
       if (value <> '') and (value[Length(value)] = ',') then
          value := Copy(value, 1, length(value) -1);
       s2.DelimitedText:= value;
       if (node <> nil) and (value <> '') and (node.HasChildren) then
       begin
         for I := 0 to ctvMandatory.Count - 1 do
          begin
           while Node <> Nil do
           begin
             node:= TcxTreeListNode(ctvMandatory.Items[I]);
             node:= node.getFirstChild;
             if not node.Checked then
             begin
               val := '';
               for val in s2 do
               begin
                 node.Checked := true;
                 node.getNextSibling;
               end;
             end;
             s2.Clear;
           end;
          end;
       end;
       value:= '';
       val := '';
       key:= ReplaceStr(str, '[', '');
       key:= ReplaceStr(key, ']', '');
       for I := 0 to ctvMandatory.Count - 1 do
       begin
         if (TcxTreeListNode(ctvMandatory.Items[i]).Values[1] = key) and ((ctvMandatory.Items[i]).Level = 0) then
         begin
           node:= TcxTreeListNode(ctvMandatory.Items[i]);
           Break;
         end;
       end;
     end
     else
     begin
       value:= value + str + ',';
     end;
   end;
   if (value <> '') and (value[Length(value)] = ',') then
      value := Copy(value, 1, length(value) -1);
   s2.DelimitedText:= value;
   if (node <> nil) and (value <> '') and (node.HasChildren) then
   begin
    for I := 0 to ctvMandatory.Count - 1 do
    begin
     while Node <> Nil do
     begin
       node:= TcxTreeListNode(ctvMandatory.Items[I]);
       node:= node.getFirstChild;
       if not node.Checked then
       begin
         val := '';
         for val in s2 do
         begin
           node.Checked := true;
           node.getNextSibling;
         end;
       end;
       s2.Clear;
     end;
    end;
   end;
   sl.Free;
   s2.Free;
  end;
  ctvMandatory.EndUpdate;
  SetMandatoryText;
end;

function TfrmTreeList.IsValueInCSV(const CSV, Value: string): Boolean;
begin
  Result := IsValueInCSV(CSV, Value, False);
end;

function TfrmTreeList.IsValueInCSV(const CSV, Value: string; ResultIfBothEmpty: Boolean): Boolean;
begin
  if Trim(CSV) = Trim(Value) then
  begin
    if Trim(Value) = '' then
      Result := ResultIfBothEmpty
    else
      Result := True;
  end
  else
    Result := MatchStr(Value, SplitString(CSV, ','));
end;

Может кто-нибудь проверить и помочь мне в этом вопросе?

Answer 1

Обновление Я обновил этот ответ, чтобы предоставить полный и автономный пример сохранения флажков TcxTreeList в строку (или TStringList), а затем повторно загрузить их, используя оба формат строки на скриншоте Q. Я проигнорировал код в Q и написал все с нуля, потому что это было проще, чем пытаться угадать, что именно вы собираетесь делать в своем коде - если бы я делал это сам, я бы не использовал метод Q но вместо этого сохраните состояния узлов дерева в TClientDataSet или эквивалент Devex.

В примере требуется только несколько служебных подпрограмм, чтобы выполнить свою работу, и все они принимают TcxTreeList или TcxTreeListNode в качестве входного параметра, чтобы они могли быть переехал в другое подразделение и повторно использовал другие формы.

Эти процедуры заключаются в следующем:

function RootNodeToString(RootNode : TcxTreeListNode) : String;
//  This saves a Root node and its subkeys in the format show in the Q's screenshot
//  Note:  This does NOT save the RootNode's checked state because the q did not define
//  whether it should

function TreeListNodesToString(TreeList : TcxTreeList) : String;
//  This saves all the TreeList's Root nodes and their subkeys
//  in the format show in the Q's screenshot

function RootNodeFromName(TreeList : TcxTreeList; AName : String) : TcxTreeListNode;
//  Finds the RootNode having a given name or NIL if not found

function ChildNodeFromName(RootNode : TcxTreeListNode; const AName : String) : TcxTreeListNode;
//  Finds the ChildNode (of a RootNode) having a given name or NIL if not found

function TreeListNodesToString(TreeList : TcxTreeList) : String;
//  This saves all the TreeList's Root nodes and their subkeys
//  in the format show in the Q's screenshot

function RootNodeFromName(TreeList : TcxTreeList; AName : String) : TcxTreeListNode;
//  Finds the RootNode having a given name or NIL if not found

function ChildNodeFromName(RootNode : TcxTreeListNode; const AName : String) : TcxTreeListNode;
//  Finds the ChildNode (of a RootNode) having a given name or NIL if not found

procedure ClearChecks(TreeList : TcxTreeList; ClearChildren : Boolean);
//  Clears all the checkmark in a cxTreeList

Надеюсь, все они говорят сами за себя. В разделе «Реализация» данного примера:

const
  iCheckCol = 0;  //  the number of the checkbox column
  iNameCol  = 1;  //  the number of the name column

function RootNodeToString(RootNode : TcxTreeListNode) : String;
//  This saves a Root node and its subkeys in the format show in the Q's screenshot
//  Note:  This does NOT save the RootNode's checked state because the q did not define
//  whether it should
var
  j : Integer;
  ANode : TcxTreeListNode;
begin
  Result := '[' + RootNode.Values[iNameCol] + ']';
  for j := 0 to RootNode.Count - 1 do begin
     ANode := RootNode.Items[j];
     if ANode.Values[iCheckCol] then
       Result := Result + ',' + ANode.Values[iNameCol];
  end;
end;

function TreeListNodesToString(TreeList : TcxTreeList) : String;
//  This saves all the TreeList's Root nodes and their subkeys
//  in the format show in the Q's screenshot
var
  i : Integer;
begin
  Result := '';
  for i := 0 to TreeList.Count - 1 do begin
    if Result <> '' then
      Result := Result + ',';
    Result := Result + RootNodeToString(TreeList.Items[i]);
  end;
end;

function RootNodeFromName(TreeList : TcxTreeList; AName : String) : TcxTreeListNode;
//  Finds the RootNode having a given name or NIL if not found
var
  i : Integer;
begin
  //  First remove the square brackets, if any
  if AName[1] = '[' then
    Delete(AName, 1, 1);
  if AName[Length(AName)] = ']' then
    Delete(AName, Length(AName), 1);
  //  Next, look for AName in TreeList
  for i := 0 to TreeList.Count - 1 do begin
    Result := TreeList.Items[i];
    if CompareText(Result.Values[iNameCol], AName) = 0 then exit; //CompareText is case-insensitive
  end;
  Result := Nil; // if we get to here,  we didn't find it
end;

function ChildNodeFromName(RootNode : TcxTreeListNode; const AName : String) : TcxTreeListNode;
//  Finds the ChildNode (of a RootNode) having a given name or NIL if not found
var
  i : Integer;
begin
  for i := 0 to RootNode.Count - 1 do begin
    Result := RootNode.Items[i];
    if CompareText(Result.Values[iNameCol], AName) = 0 then exit; //CompareText is case-insensitive
  end;
  Result := Nil; // if we get to here,  we didn't find it
end;

procedure ClearChecks(TreeList : TcxTreeList; ClearChildren : Boolean);
//  Clears all the checkmark in a cxTreeList
var
  i,
  j : Integer;
  RootNode,
  ANode : TcxTreeListNode;
begin
  //  This clears the checkmarks from all the Root nodes and, optionally,
  //  their children
  TreeList.BeginUpdate;
  try
    for i := 0 to TreeList.Count - 1 do begin
      RootNode := TreeList.Items[i];
      RootNode.Values[iCheckCol] := False;
      for j := 0 to RootNode.Count - 1 do begin
        ANode := RootNode.Items[j];
        ANode.Values[iCheckCol] := False;
      end;
    end;
  finally
    TreeList.EndUpdate;
  end;
end;

procedure LoadTreeListChecksFromString(TreeList : TcxTreeList; const Input : String);
//  This clears the TreeList's checkmarks and then sets the checkmarks
//  from the Input string.
var
  RootKey,
  SubKey : String;
  RootNode,
  ChildNode : TcxTreeListNode;
  TL : TStringList;
  i : Integer;
begin
  TreeList.BeginUpdate;
  try
    //  First, clear the treelist's checkmarks
    ClearChecks(TreeList, True);

    //  Next load the Input string into a TStringList to split it into a series
    //  of Root keys and Child keys
    TL := TStringList.Create;
    try
      TL.CommaText := Input;

      //  The i variable will be used to iterate through the contents of the  StringList
      i := 0;
      while i <= TL.Count - 1 do begin
        //  The first string in TL should be  Root key
        RootKey := TL[i];
        RootNode := RootNodeFromName(TreeList, RootKey);
        Assert(RootNode <> Nil);  // will raise exception if RootNode not found
        //  The question does not say what should happen about the checkmark on the root nodes
        Inc(i);

        //  Now, scan down the entries below the Root key and process retrive each if its sub-keys;
        //  stop when we get to the next Root key or reach the end of the Stringlist
        while (i <= TL.Count - 1) and (Pos('[', TL[i]) <> 1) do begin
          SubKey := TL[i];
          ChildNode := ChildNodeFromName(RootNode, SubKey);
          ChildNode.Values[iCheckCol] := True;
          Inc(i);
        end;
      end;
    finally
      TL.Free;
    end;
  finally
    TreeList.EndUpdate;
  end;
end;

procedure TForm1.SetUpTreeList;
//  This sets up the form' cxTreeList with some Root nodes and Child nodes
//  Some of the ChildNode's checkmarks are set to save having to click around
//  to set things up manually
var
  i,
  j : Integer;
  RootNode,
  ANode : TcxTreeListNode;
begin
  for i := 0 to 3 do begin
    RootNode := cxTreeList1.Add;
    RootNode.AssignValues([Odd(i), 'RT' + IntToStr(i + 1)]);
    for j := 0 to 4 do begin
      ANode := RootNode.AddChild;
      ANode.AssignValues([Odd(i + j), Char(j + Ord('A'))]);
    end;
    RootNode.Expand(True);
  end;
  edSavedKeys.Text := TreeListNodesToString(cxTreeList1);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SetUpTreeList;
end;

procedure TForm1.btnClearClick(Sender: TObject);
begin
  ClearChecks(cxTreeList1, True);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetNodeChecked(cxTreeList1.FocusedNode, not cxTreeList1.FocusedNode.Values[iCheckCol]);
end;

procedure TForm1.SetNodeChecked(Node : TcxTreeListNode; Value : Boolean);
begin
   if Node = Nil then exit;  // do nothing
   Node.Values[iCheckCol] := Value;
end;

procedure TForm1.btnLoadClick(Sender: TObject);
begin
  ClearChecks(cxTreeList1, True);
  LoadTreeListChecksFromString(cxTreeList1, edSavedKeys.Text);
end;

end.

Оригинальный ответ

Самый простой способ установить столбец флажка несвязанного cxTreeList - просто установить значение в этот столбец в True или False. Итак, предполагая, что столбец CheckBox вашего cxTreeList равен столбцу 0, вы можете просто сделать это

procedure TForm1.SetNodeChecked(Node : TcxTreeListNode; Value : Boolean);
begin
   if Node = Nil then exit;  // do nothing
   Node.Values[0] := Value;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  //  toggle the checkbox of the focused node using code
  SetNodeChecked(cxTreeList1.FocusedNode, not cxTreeList1.FocusedNode.Values[0]);
end;

Я предполагаю, что вы можете встроить это в существующий код. Я на самом деле не изучал это, но подозреваю, что вы могли бы значительно упростить это.