cxpropertiesstoreeditor.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,002 行 · 第 1/2 页

PAS
1,002
字号
        ChangeCheckState(Tree.Selected);
      finally
        EndUpdate();
      end;
    end;
end;

procedure TfrmPropertiesStoreEditor.btnCheckAllClick(Sender: TObject);
begin
  CheckAll;
end;

procedure TfrmPropertiesStoreEditor.btnUncheckAllClick(Sender: TObject);
begin
  UncheckAll;
end;

procedure TfrmPropertiesStoreEditor.LoadFromPropertiesStore(
  APropertiesStore: TcxPropertiesStore);

  function ExtractName(var AName: string): string;
  var
    AIndex: Integer;
  begin
    Result := '';
    AIndex := Pos('.', AName);
    if AIndex > 0 then
    begin
      if AIndex > 1 then
        Result := Copy(AName, 1, AIndex - 1);
      Delete(AName, 1, AIndex);
    end
    else
    begin
      Result := AName;
      AName := '';
    end;
  end;

  function GetPropertyNode(APersistentNode: TTreeNode; const APropertyName: string): TTreeNode;
  var
    AName: string;
    AUpperCaseCurrentName: string;
    ACurrentName: string;
    I: Integer;
  begin
    Result := nil;
    AName := APropertyName;
    ACurrentName := ExtractName(AName);
    if ACurrentName <> '' then
    begin
      AUpperCaseCurrentName := UpperCase(ACurrentName);
      for I := 0 to APersistentNode.Count - 1 do
        if UpperCase(APersistentNode[I].Text) = AUpperCaseCurrentName then
        begin
          Result := APersistentNode[I];
          Break;
        end;
      if Result <> nil then
      begin
        if AName <> '' then
          Result := GetPropertyNode(Result, AName);
      end;
    end;
  end;

  function GetPersistentNode(APersistent: TPersistent): TTreeNode;
  var
    ANode: TTreeNode;
  begin
    Result := nil;
    ANode := Tree.Items.GetFirstNode;
    while ANode <> nil do
    begin
      if ANode.Data <> nil then
        with PfrmPropertiesStoreRecord(ANode.Data)^ do
          if (Persistent = APersistent) and (PropertyName = '') then
          begin
            Result := ANode;
            Break;
          end;
      ANode := ANode.getNextSibling;
    end;
  end;

  function GetPersistentNodeByProperty(var APropertyName: string; APersistent: TPersistent): TTreeNode;
  var
    APropertyNode: TTreeNode;
    AName: string;
    AUpperCaseName: string;
    I: Integer;
  begin
    Result := nil;
    if (APropertyName = '') or (APersistent = nil) then
      Exit;
    AName := ExtractName(APropertyName);
    if AName <> '' then
    begin
      AUpperCaseName := UpperCase(AName);
      APropertyNode := Tree.Items.GetFirstNode;
      while APropertyNode <> nil do
      begin
        if AUpperCaseName = UpperCase(APropertyNode.Text) then
          for I := 0 to APropertyNode.Count - 1 do
            if APropertyNode[I].Data <> nil then
              if PfrmPropertiesStoreRecord(APropertyNode[I].Data)^.Persistent = APersistent then
              begin
                Result := APropertyNode[I];
                Exit;
              end;
        APropertyNode := APropertyNode.getNextSibling;
      end;
    end;
  end;

var
  APS: TcxPropertiesStore;
  I, J: Integer;
  APersistentNode: TTreeNode;
  APropertyNode: TTreeNode;
  APropertyName: string;
begin
  if APropertiesStore = nil then
    APS := PropertiesStore
  else
    APS := APropertiesStore;
  if APS <> nil then
  begin
    for I := 0 to APS.Components.Count - 1 do
      with APS.Components[I] do
      begin
        if Grouping = psgComponents then
        begin
          APersistentNode := GetPersistentNode(Component);
          if APersistentNode <> nil then
          begin
            for J := 0 to Properties.Count - 1 do
            begin
              APropertyNode := GetPropertyNode(APersistentNode, Properties[J]);
              if APropertyNode <> nil then
                if APropertyNode.Data <> nil then
                  CheckNode(APropertyNode);
            end;
          end;
        end
        else if Grouping = psgProperties then
        begin
          for J := 0 to Properties.Count - 1 do
          begin
            APropertyName := Properties[J];
            APersistentNode := GetPersistentNodeByProperty(APropertyName, Component);
            if APersistentNode <> nil then
            begin
              if APropertyName <> '' then
              begin
                APropertyNode := GetPropertyNode(APersistentNode, APropertyName);
                if APropertyNode <> nil then
                  CheckNode(APropertyNode);
              end
              else
                CheckNode(APersistentNode);
            end;
          end;
        end;
      end;
  end;
end;

procedure TfrmPropertiesStoreEditor.FormShow(Sender: TObject);
begin
  LoadFromPropertiesStore(nil);
end;

procedure TfrmPropertiesStoreEditor.btnResetClick(Sender: TObject);
begin
  Reset;
end;

procedure TfrmPropertiesStoreEditor.SaveToPropertiesStore(
  APropertiesStore: TcxPropertiesStore);
var
  APS: TcxPropertiesStore;

  procedure SaveComponentProperties(APSC: TcxPropertiesStoreComponent;
    ANode: TTreeNode; const AName: string);
  var
    I: Integer;
  begin
    for I := 0 to ANode.Count - 1 do
    begin
      if IsNodeFullChecked(ANode[I]) then
        APSC.Properties.Add(AName + '.' + ANode[I].Text)
      else
      begin
        if IsNodeChecked(ANode[I]) then
          SaveComponentProperties(APSC, ANode[I], AName + '.' + ANode[I].Text);
      end;
    end;
  end;

  procedure SaveComponent(APersistentNode: TTreeNode);
  var
    APSC: TcxPropertiesStoreComponent;
    APersistent: TPersistent;
    I: Integer;
  begin
    APersistent := PfrmPropertiesStoreRecord(APersistentNode.Data)^.Persistent;
    if APersistent is TComponent then
    begin
      APSC := APS.Components.Add as TcxPropertiesStoreComponent;
      APSC.Component := APersistent as TComponent;
      for I := 0 to APersistentNode.Count - 1 do
      begin
        if IsNodeFullChecked(APersistentNode[I]) then
          APSC.Properties.Add(APersistentNode[I].Text)
        else
        begin
          if IsNodeChecked(APersistentNode[I]) then
            SaveComponentProperties(APSC, APersistentNode[I], APersistentNode[I].Text);
        end;
      end;
    end;
  end;

  function GetPropertiesStoreComponent(AComponent: TComponent): TcxPropertiesStoreComponent;
  var
    I: Integer;
  begin
    Result := nil;
    for I := 0 to APS.Components.Count - 1 do
      if APS.Components[I].Component = AComponent then
      begin
        Result := APS.Components[I];
        Break;
      end;
    if Result = nil then
    begin
      Result := APS.Components.Add as TcxPropertiesStoreComponent;
      Result.Component := AComponent;
    end;
  end;

  procedure SaveComponentByProperty(APropertyNode: TTreeNode);
  var
    APropertyName: string;
    I: Integer;
    APSC: TcxPropertiesStoreComponent;
    APersistent: TPersistent;
  begin
    APropertyName := APropertyNode.Text;
    for I := 0 to APropertyNode.Count - 1 do
    begin
      if IsNodeChecked(APropertyNode[I]) then
      begin
        APersistent := PfrmPropertiesStoreRecord(APropertyNode[I].Data)^.Persistent;
        if APersistent is TComponent then
        begin
          APSC := GetPropertiesStoreComponent(APersistent as TComponent);
          if IsNodeFullChecked(APropertyNode[I]) then
            APSC.Properties.Add(APropertyName)
          else
            SaveComponentProperties(APSC, APropertyNode[I], APropertyName);
        end;
      end;
    end;
  end;

var
  ANode: TTreeNode;
begin
  if APropertiesStore = nil then
    APS := PropertiesStore
  else
    APS := APropertiesStore;
  if APS <> nil then
  begin
    APS.Components.Clear;
    ANode := Tree.Items.GetFirstNode;
    while ANode <> nil do
    begin
      if IsNodeChecked(ANode) then
      begin
        if ANode.Data <> nil then
        begin
          if Grouping = psgComponents then
            SaveComponent(ANode)
          else if Grouping = psgProperties then
            SaveComponentByProperty(ANode);
        end;
      end;
      ANode := ANode.getNextSibling;
    end;
  end;
end;

function TfrmPropertiesStoreEditor.IsNodeFullChecked(
  ANode: TTreeNode): Boolean;
var
  I: Integer;
begin
  Result := PfrmPropertiesStoreRecord(ANode.Data)^.Stored;
  if Result then
  begin
    for I := 0 to ANode.Count - 1 do
      Result := Result and IsNodeFullChecked(ANode[I]);
  end;
end;

function TfrmPropertiesStoreEditor.IsNodeChecked(
  ANode: TTreeNode): Boolean;
begin
  Result := PfrmPropertiesStoreRecord(ANode.Data)^.Stored;
end;

procedure TfrmPropertiesStoreEditor.BeginUpdate;
begin
  Tree.Items.BeginUpdate;
end;

procedure TfrmPropertiesStoreEditor.EndUpdate;
begin
  Tree.Items.EndUpdate;
end;

procedure TfrmPropertiesStoreEditor.InvertCheck;

  procedure InvertCheckNode(ANode: TTreeNode);
  var
    I: Integer;
  begin
    for I := 0 to ANode.Count - 1 do
    begin
      if IsNodeChecked(ANode[I]) then
      begin
        if IsNodeFullChecked(ANode[I]) then
          UncheckNode(ANode[I])
        else
          InvertCheckNode(ANode[I]);
      end
      else
        CheckNode(ANode[I]);
    end;
  end;

var
  ANode: TTreeNode;
begin
  ANode := Tree.Items.GetFirstNode;
  while ANode <> nil do
  begin
    if IsNodeChecked(ANode) then
    begin
      if IsNodeFullChecked(ANode) then
        UncheckNode(ANode)
      else
        InvertCheckNode(ANode);
    end
    else
      CheckNode(ANode);
    ANode := ANode.getNextSibling;
  end;
end;

procedure TfrmPropertiesStoreEditor.btnInvertCheckingClick(Sender: TObject);
begin
  InvertChecking;
end;

procedure TfrmPropertiesStoreEditor.SetFindText;
begin
  if Grouping = psgComponents then
    lblFindComponent.Caption := scxFindComponent
  else if Grouping = psgProperties then
    lblFindComponent.Caption := scxFindProperty;
  edFindComponent.Left := lblFindComponent.Left + lblFindComponent.Width + 9;
  edFindComponent.Width := Tree.Left + Tree.Width - edFindComponent.Left - 7;
end;

procedure TfrmPropertiesStoreEditor.edFindComponentKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
var
  ANode: TTreeNode;
begin
  if TranslateKey(Key) = VK_RETURN then
  begin
    ANode := FindNode(edFindComponent.Text);
    if ANode <> nil then
    begin
      Tree.Selected := ANode;
      Tree.SetFocus;
    end;
  end;
end;

function TfrmPropertiesStoreEditor.FindNode(const AText: string): TTreeNode;
var
  I: Integer;
  ANode: TTreeNode;
  ANodeText: string;
  AFindText: string;
  ACount, ACount1: Integer;
begin
  AFindText := UpperCase(AText);
  ANode := Tree.Items.GetFirstNode;
  ACount1 := -1;
  Result := nil;
  while ANode <> nil do
  begin
    ACount := 0;
    ANodeText := UpperCase(ANode.Text);
    for I := 1 to Length(AFindText) do
    begin
      if I > Length(ANodeText) then
        Break;
      if AFindText[I] = ANodeText[I] then
        Inc(ACount)
      else
        Break;
    end;
    if ACount > ACount1 then
    begin
      ACount1 := ACount;
      Result := ANode;
    end;
    ANode := ANode.getNextSibling;
  end;
end;

procedure TfrmPropertiesStoreEditor.CheckAll;
var
  ANode: TTreeNode;
begin
  BeginUpdate;
  try
    ANode := Tree.Items.GetFirstNode;
    while ANode <> nil do
    begin
      CheckNode(ANode, True, False);
      ANode := ANode.getNextSibling;
    end;
  finally
    EndUpdate;
  end;
end;

procedure TfrmPropertiesStoreEditor.InvertChecking;
begin
  BeginUpdate;
  try
    InvertCheck;
  finally
    EndUpdate;
  end;
end;

procedure TfrmPropertiesStoreEditor.Reset;
begin
  BeginUpdate;
  try
    RefreshTree;
    LoadFromPropertiesStore(nil);
  finally
    EndUpdate;
  end;
end;

procedure TfrmPropertiesStoreEditor.UncheckAll;
var
  ANode: TTreeNode;
begin
  BeginUpdate;
  try
    ANode := Tree.Items.GetFirstNode;
    while ANode <> nil do
    begin
      if PfrmPropertiesStoreRecord(ANode.Data)^.Stored then
        UncheckNode(ANode, True, False);
      ANode := ANode.getNextSibling;
    end;
  finally
    EndUpdate;
  end;

end;

procedure TfrmPropertiesStoreEditor.TreeContextPopup(Sender: TObject;
  MousePos: TPoint; var Handled: Boolean);
begin
  if Tree.Selected <> nil then
  begin
    BeginUpdate;
    try
      ChangeCheckState(Tree.Selected);
    finally
      EndUpdate;
    end;
  end;
end;

end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?