jvregistrytreeview.pas

East make Tray Icon in delphi

  AListView: TListViewAccessProtected;
begin
  Result := False;
  if not Assigned(FListView) then
    Exit;
  OpenRegistry(Node);
  AListView := TListViewAccessProtected(FListView);
  AListView.Items.BeginUpdate;
  try
    AListView.Items.Clear;
    if AListView.SmallImages = nil then
      AListView.SmallImages := Images;
    if (Node = nil) or (Node = Items.GetFirstNode) then
      Exit;
    { set current root }
    DefaultSet := False;
    if FReg.OpenKeyReadOnly(GetKeyPath(Node)) then
    begin
      if FReg.GetKeyInfo(Info) then
      begin
        for I := 0 to Info.NumValues - 1 do
        begin
          Len := Info.MaxValueLen + 1;
          Len1 := Info.MaxDataLen + 1;
          SetLength(S, Len);
          SetLength(D, Len1);
          DataType := 0;
          RegEnumValue(FReg.CurrentKey, I, PChar(S), Len, nil, @DataType, @D[0], @Len1);
          SetLength(S,Len);
          { set default item }
          if (S = '') and not DefaultSet then
          begin
            TmpItem := AListView.Items.Insert(0);
            TmpItem.Caption := FDefaultCaption;
            DefaultSet := True;
          end
          else
          begin
            TmpItem := AListView.Items.Add;
            TmpItem.Caption := S;
          end;
          case DataType of
            REG_SZ, REG_EXPAND_SZ,REG_MULTI_SZ:
              begin
                if DataType = REG_MULTI_SZ then
                  for J := 0 to Pred(Len1) do
                    if D[J] = 0 then
                      D[J] := Ord(' ');
                T := string(PChar(D));
                if (T = '') and AnsiSameText(TmpItem.Caption, FDefaultCaption) then
                  T := FDefaultNoValue;
                TmpItem.ImageIndex := imText;
                TmpItem.SubItems.Add(T);
              end;
            REG_DWORD:
              begin
                TmpItem.ImageIndex := imBin;
                TmpItem.SubItems.Add(Format('0x%.8x (%d)', [Cardinal(Pointer(D)^),Cardinal(Pointer(D)^)]));
              end;
            REG_NONE:
              begin
                TmpItem.ImageIndex := imText;
                TmpItem.SubItems.Add(RsUnknownCaption);
              end;
            else
            begin
              TmpItem.ImageIndex := imBin;
              TmpItem.SubItems.Add(BufToStr(D, Len1));
            end;
          end;
          TmpItem.SubItems.Add(RegTypes(DataType));
        end;
      end;
      Result := True;
    end;
    { set default item }
    if (Node.Parent <> nil) and not DefaultSet then
    begin
      TmpItem := AListView.Items.Insert(0);
      TmpItem.ImageIndex := imText;
      TmpItem.Caption := FDefaultCaption;
      TmpItem.SubItems.Add(FDefaultNoValue);
      TmpItem.SubItems.Add('REG_SZ');
    end;
  finally
    AListView.Items.EndUpdate;
    CloseRegistry;
  end;
end;

procedure TJvRegistryTreeView.SetDefaultCaption(Value: string);
begin
  FDefaultCaption := Value;
  FillListView(Selected);
end;

procedure TJvRegistryTreeView.SetDefaultNoValue(Value: string);
begin
  FDefaultNoValue := Value;
  FillListView(Selected);
end;

procedure TJvRegistryTreeView.SetRootCaption(Value: string);
begin
  FRootCaption := Value;
  BuildTree;
end;

procedure TJvRegistryTreeView.SetRegistryKeys(Value: TJvRegKeys);
begin
  if FRegistryKeys <> Value then
    FRegistryKeys := Value;
  BuildTree;
end;

procedure TJvRegistryTreeView.BuildTree;
var
  NewNode, ANode: TTreeNode;
begin
  OpenRegistry(nil);
  Items.BeginUpdate;
  try
    Items.Clear;
    ANode := Items.Add(nil, FRootCaption);
    ANode.ImageIndex := imMyPC;
    ANode.SelectedIndex := imMyPC;
    if hkClassesRoot in FRegistryKeys then
    begin
      FReg.RootKey := HKEY_CLASSES_ROOT;
      NewNode := Items.AddChild(ANode, 'HKEY_CLASSES_ROOT');
      NewNode.ImageIndex := imClosed;
      NewNode.SelectedIndex := imOpen;
      NewNode.Data := Pointer(FReg.RootKey);
      if not (csDesigning in ComponentState) then
        RefreshSubTrees(NewNode, '\', '', 1);
    end;

    if hkCurrentUser in FRegistryKeys then
    begin
      FReg.RootKey := HKEY_CURRENT_USER;
      NewNode := Items.AddChild(ANode, 'HKEY_CURRENT_USER');
      NewNode.ImageIndex := imClosed;
      NewNode.SelectedIndex := imOpen;
      NewNode.Data := Pointer(FReg.RootKey);
      if not (csDesigning in ComponentState) then
        RefreshSubTrees(NewNode, '\', '', 1);
    end;

    if hkLocalMachine in FRegistryKeys then
    begin
      FReg.RootKey := HKEY_LOCAL_MACHINE;
      NewNode := Items.AddChild(ANode, 'HKEY_LOCAL_MACHINE');
      NewNode.ImageIndex := imClosed;
      NewNode.SelectedIndex := imOpen;
      NewNode.Data := Pointer(FReg.RootKey);
      if not (csDesigning in ComponentState) then
        RefreshSubTrees(NewNode, '\', '', 1);
    end;

    if hkUsers in FRegistryKeys then
    begin
      FReg.RootKey := HKEY_USERS;
      NewNode := Items.AddChild(ANode, 'HKEY_USERS');
      NewNode.ImageIndex := imClosed;
      NewNode.SelectedIndex := imOpen;
      NewNode.Data := Pointer(FReg.RootKey);
      if not (csDesigning in ComponentState) then
        RefreshSubTrees(NewNode, '\', '', 1);
    end;

    if hkPerformanceData in FRegistryKeys then
    begin
      FReg.RootKey := HKEY_PERFORMANCE_DATA;
      NewNode := Items.AddChild(ANode, 'HKEY_PERFORMANCE_DATA');
      NewNode.ImageIndex := imClosed;
      NewNode.SelectedIndex := imOpen;
      NewNode.Data := Pointer(FReg.RootKey);
      if not (csDesigning in ComponentState) then
        RefreshSubTrees(NewNode, '\', '', 1);
    end;

    if hkCurrentConfig in FRegistryKeys then
    begin
      FReg.RootKey := HKEY_CURRENT_CONFIG;
      NewNode := Items.AddChild(ANode, 'HKEY_CURRENT_CONFIG');
      NewNode.ImageIndex := imClosed;
      NewNode.SelectedIndex := imOpen;
      NewNode.Data := Pointer(FReg.RootKey);
      if not (csDesigning in ComponentState) then
        RefreshSubTrees(NewNode, '\', '', 1);
    end;
    if hkDynData in FRegistryKeys then
    begin
      FReg.RootKey := HKEY_DYN_DATA;
      NewNode := Items.AddChild(ANode, 'HKEY_DYN_DATA');
      NewNode.ImageIndex := imClosed;
      NewNode.SelectedIndex := imOpen;
      NewNode.Data := Pointer(FReg.RootKey);
      if not (csDesigning in ComponentState) then
        RefreshSubTrees(NewNode, '\', '', 1);
    end;
    ANode.Expand(False);
    ANode.Selected := True;
  finally
    CloseRegistry;
    Items.EndUpdate;
  end;
end;

function TJvRegistryTreeView.CanCollapse(Node: TTreeNode): Boolean;
begin
  Result := inherited CanCollapse(Node);
  {  if Result then
      Node.ImageIndex := imClosed;}
end;

function TJvRegistryTreeView.CanExpand(Node: TTreeNode): Boolean;
begin
  Result := inherited CanExpand(Node);
  if not Result or (Node.Parent = nil) then
    Exit;
  OpenRegistry(Node);
  try
    //  Node.ImageIndex := imOpen;
    //  Node.DeleteChildren;
    SetRootKey(FReg, Node);
    if not (csDesigning in ComponentState) and (Node.Count = 0) then
      RefreshSubTrees(Node, FixupPath(GetKeyPath(Node)), '', 2);
  finally
    CloseRegistry;
  end;
end;

procedure TJvRegistryTreeView.Change(Node: TTreeNode);
begin
  FillListView(Node);
  inherited Change(Node);
end;

procedure TJvRegistryTreeView.CreateParams(var Params: TCreateParams);
const
  TVS_NOTOOLTIPS = $0080;
begin
  inherited CreateParams(Params);
  if not ShowHint then
    Params.Style := Params.Style or TVS_NOTOOLTIPS;
end;

procedure TJvRegistryTreeView.CreateWnd;
begin
  inherited CreateWnd;
  SetDefaultImages;
  BuildTree;
end;

procedure TJvRegistryTreeView.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FListView) and (Operation = opRemove) then
  begin
    if TListViewAccessProtected(FListView).SmallImages = FInternalImages then
      TListViewAccessProtected(FListView).SmallImages := nil;
    FListView := nil;
  end;
  if (AComponent = Images) and (Operation = opRemove) then
    SetDefaultImages;
end;

procedure TJvRegistryTreeView.RefreshNode(Node: TTreeNode);
var
  B: Boolean;
begin
  Items.BeginUpdate;
  try
    B := False;
    if Node <> nil then
      B := Node.Expanded;
    OpenRegistry(Node);
    try
      if Node <> nil then
        Node.DeleteChildren;
      if (Node = nil) or (Node = Items.GetFirstNode) then
        BuildTree
      else
      begin
        SetRootKey(FReg, Node);
        RefreshSubTrees(Node, FixupPath(GetKeyPath(Node)), '', 2);
      end;
    finally
      if Node <> nil then
        Node.Expanded := B;
      CloseRegistry;
    end;
  finally
    Items.EndUpdate;
  end;
end;

function TJvRegistryTreeView.FindChildNode(ParentNode: TTreeNode; const Name: string): TTreeNode;
var
  N: TTreeNode;
begin
  Result := nil;
  if ParentNode = nil then
    Exit;
  N := ParentNode.getFirstChild;
  while Assigned(N) do
  begin
    if AnsiSameText(N.Text, Name) then
    begin
      Result := N;
      Exit;
    end;
    N := N.getNextSibling;
  end;
end;

function TJvRegistryTreeView.AddBinaryValue(ParentNode: TTreeNode;
  const Name: string; var Buf; BufSize: Integer): TTreeNode;
begin
  Result := nil;
  if ParentNode = nil then
    Exit;
  OpenRegistry(ParentNode);
  FReg.WriteBinaryData(FixupPath(GetKeyPath(ParentNode)) + Name,
    Buf, BufSize);
  CloseRegistry;
  RefreshNode(ParentNode);
  Result := FindChildNode(ParentNode, Name);
end;

function TJvRegistryTreeView.AddDWORDValue(ParentNode: TTreeNode;
  const Name: string; Value: DWORD): TTreeNode;
begin
  Result := nil;
  if ParentNode = nil then
    Exit;
  OpenRegistry(ParentNode);
  FReg.WriteInteger(FixupPath(GetKeyPath(ParentNode)) + Name, Value);
  CloseRegistry;
  RefreshNode(ParentNode);
  Result := FindChildNode(ParentNode, Name);
end;

function TJvRegistryTreeView.AddKey(ParentNode: TTreeNode;
  const KeyName: string): TTreeNode;
begin
  Result := nil;
  if ParentNode = nil then
    Exit;
  OpenRegistry(ParentNode);
  FReg.OpenKey(FixupPath(GetKeyPath(ParentNode)) + KeyName, True);
  CloseRegistry;
  RefreshNode(ParentNode);
  Result := FindChildNode(ParentNode, KeyName);
end;

function TJvRegistryTreeView.AddStringValue(ParentNode: TTreeNode;
  const Name, Value: string): TTreeNode;
begin
  Result := nil;
  if ParentNode = nil then
    Exit;
  OpenRegistry(ParentNode);
  FReg.WriteString(FixupPath(GetKeyPath(ParentNode)) + Name, Value);
  CloseRegistry;
  RefreshNode(ParentNode);
  Result := FindChildNode(ParentNode, Name);
end;

procedure TJvRegistryTreeView.CloseRegistry;
begin
  FReg.Free;
  FReg := nil;
end;

procedure TJvRegistryTreeView.OpenRegistry(Node: TTreeNode);
begin
  if FReg = nil then
    FReg := TRegistry.Create;
  SetRootKey(FReg, Node);
end;

function TJvRegistryTreeView.LoadKey(const Filename: string): Boolean;
begin
  OpenRegistry(Selected);
  Result := FReg.LoadKey(ShortPath, ChangeFileExt(Filename, ''));
  CloseRegistry;
end;

function TJvRegistryTreeView.SaveKey(const Filename: string): Boolean;
begin
  OpenRegistry(Selected);
  Result := FReg.SaveKey(ShortPath, Filename);
  CloseRegistry;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.