La función Assigned

Assigned es un función sencilla y muy útil, devuelve True si el parámetro pasado no es Nil y False si es Nil, pero cuidado que las variables del tipo puntero no reciben el valor nil por el solo hecho de declararlas, es decir por default o de manera predeterminada; así, en el siguiente ejemplo, Assigned devolverá true:

var
  aPtrChar:PChar;
begin
  if Assigned(aPtrChar) then
    ShowMessage('aPtrChar no es nil.')
  else
    ShowMessage('aPtrChar es nil');
end;

se mostrará el mensaje de que no es nil, aunque no apunte a ningún lado. Por eso es muy recomendable utilizar esta función en lugar de preguntar si es distinto de nil: 

if aPtrChar <> nil.

Algunos ejemplo de su uso:

Si por ejemplo en un árbol queremos mostrar información sobre un nodo con el evento Click, primero hay que asegurarse de que en efecto hay un nodo seleccionado para que no ocurran desastres.

procedure TForm1.arbolClick(Sender: TObject);
begin
  if not Assigned(arbol.Selected) then Exit;
  Label1.Caption:=arbol.Path;
  MostrarArchivos;
end;

Continuando con ejemplos TTreeView:

nuevamente se verifica que el nodo esté asignado, caso contrario, se sale sin hacer nada. En este caso también se averigua si el nodo es raíz.

procedure TForm1.tvChange(Sender: TObject; Node: TTreeNode);
begin
  if (not(Assigned(Node)) or (Node.Level<1)) then Exit;
  edNombre.Text:=tv.Selected.Text;
  edDocumento.Text:=PRegistro(tv.Selected.Data)^.documento;
  edNacionalidad.Text:=PRegistro(tv.Selected.Data)^.nacionalidad;
  edEstadoCivil.Text:=PRegistro(tv.Selected.Data)^.estadocivil;
end;

Un caso con TStringList:

procedure TFFiltrar.FormCreate(Sender: TObject);
begin
  if not(Assigned(filtros)) then filtros:=TStringList.Create;
  Memo1.Lines:=filtros;
end; 

la variable filtros está declarada en otra unidad y puede ser que ya haya sido creada (inicializada o instanceada) por eso, ante de intentar crearla dos veces, lo que generará un hermoso run time error, se verifica mediante Assigned.

Para finalizar, un ejemplo de TListView:

procedure TForm1.BQuitarClick(Sender: TObject);
begin
  if ((LView.Items.Count<1) or (not Assigned(LView.Selected))) then Exit;
  ListaCarpetas.Borrar(LView.Items[LView.ItemIndex].Caption);
  ListaCarpetas.ToListView(LView);
end;

se usa Assigned sobre TListView.Selected, de esta forma si no hay ningún elemento seleccionado, no se hace nada.

Listar archivos de un directorio: FindFirst

FindFirst, FindNext y FindClose: se utilizan para obtener el contenido de un path, carpeta o directorio (contenido = archivos y directorios).

La primera función, FindFirst, inicia la búsqueda, la segunda función, FindNext la continúa y finalmente el procedimiento FindClose, la finaliza.

function FindFirst(

  const Path: RawByteString;

  Attr: LongInt;

  out Rslt: TRawbyteSearchRec

):LongInt;

El tipo RawByteString es un string que no tiene asociado ningún código de página.

Attr: es un campo de bit y se maneja con operaciones bit a bit, "Bitwise operation", no obstante se puede utilizar perfectamente sin tener conocimientos al respecto pero sabiendo al menos de que se trata. Para ello debemos hacer uso de las constantes que comienzan por "fa" por "File attributes".

Const
  { File attributes }
  faReadOnly   = $00000001;
  faHidden     = $00000002 platform;
  faSysFile    = $00000004 platform;
  faVolumeId   = $00000008 platform deprecated;
  faDirectory  = $00000010;
  faArchive    = $00000020;
  faNormal     = $00000080;
  faTemporary  = $00000100 platform;
  faSymLink    = $00000400 platform;
  faCompressed = $00000800 platform;
  faEncrypted  = $00004000 platform;
  faVirtual    = $00010000 platform;
  faAnyFile    = $000001FF; 

El parámetro tipo out: es muy parecido a usar var, también es pasado por referencia, la diferencia es que el valor inicial (si es que lo tiene) se descarta. Si no está inicializado el valor, el compilador tampoco enviará una advertencia.

TRawbyteSearchRec es un registro:

type TRawbyteSearchRec = record
  Time: LongInt; // Last modification timestamp
  Size: Int64; // File size in bytes
  Attr: LongInt; // File attributes
  Name: RawByteString; // File name (single byte version)
  ExcludeAttr: LongInt; // For internal use only
  FindHandle: Pointer; // Native file search handle. For internal use only, treat as opaque
  Mode: TMode; // File permissions (mode, Unix only)
end;

El resultado de la función: 0 (cero) si encuentra un archivo o un valor distinto a cero en caso contrario.

function FindNext(

  var Rslt: TRawbyteSearchRec

):LongInt;

Como la búsqueda ya fue iniciada por FindFirst, no necesita ni el path ni attr y como vemos, el resultado en lugar de out es var. Generalmente se la utiliza como condicional para un ciclo repeat until:

until FindNext(Arch)<>0;  

Devuelve 0 (cero) en caso de haber encontrado una coincidencia y un valor distinto de cero en caso contrario, igual que FindFirst.

procedure FindClose(

  var F: TRawbyteSearchRec

);

Al igual que las funciones FindFirst y FindNext, el procedimiento FindClose recibe por referencia el registro TRawbyteSearchRec y finaliza la serie de llamadas FindFirst/FindNext. Siempre debe utilizarse para evitar fugas de memoria.

Como ejemplo tendremos un TShellTreeView cuyo evento OnClick mostrará los archivos de la carpeta en un TMemo. Además un par de TCheckBox para mostrar u ocultar en el listado (TMemo) los archivos ocultos y/o subdirectorios o subcarpetas. Unos TLabel para información de la cantidad de archivos mostrados y su tamaño.

procedure TForm1.arbolClick(Sender: TObject);
begin
  if not Assigned(arbol.Selected) then Exit;
  Label1.Caption:=arbol.Path;
  MostrarArchivos;
end;    

La función Assigned:

function Assigned(

  P: Pointer

):Boolean;

Comprueba si el valor del puntero no es nil y devuelve TRUE, caso contrario devuelve FALSE. Sería lo mismo que:
if arbol.Selected=nil then Exit;

procedure TForm1.MostrarArchivos;
var
  Arch:TSearchRec;
  den:String='';
  linea:String='';
begin
  TotArchivos:=0;
  TotCarpetas:=0;
  TotTamanio:=0;
  Memo1.Clear;
  opciones:=GetOpciones;
  case opciones of
    0 : if FindFirst(arbol.Path+'*',faHidden or faDirectory,Arch)<>0 then Exit;  //Si encontró devuelve 0 cero.
    1 : if FindFirst(arbol.Path+'*',faDirectory,Arch)<>0 then Exit;
    2 : if FindFirst(arbol.Path+'*',not faHidden and not faDirectory,Arch)<>0 then Exit;
    3 : if FindFirst(arbol.Path+'*',faHidden and not faDirectory,Arch)<>0 then Exit;
  end;
  repeat
    if ((Arch.Name<>'.') and (Arch.Name<>'..')) then
    begin
      linea:=Format('%0:-40s',[' '+Arch.Name]);
      if (Arch.Attr and  faDirectory)<>0 then
        begin
          linea:=linea+Format('%0:12s',['[Dir]']);
          Inc(TotCarpetas);
        end
      else
        begin
          linea:=linea+Format('%8.2n',[Tamanio(den,Arch.Size)])+Format('%0:4s',[den]);
          Inc(TotArchivos);
          TotTamanio:=TotTamanio+Arch.Size;
        end;
      linea:=linea+Format('%0:20s',[DateTimeToStr(FileDateToDateTime(Arch.Time))]);
      Memo1.Lines.Add(linea);
    end;
    lTotArch.Caption:=IntToStr(TotArchivos);
    lTam.Caption:=FormatFloat('0.00',(Tamanio(den,TotTamanio)))+' '+den;
    lTotSubDir.Caption:=IntToStr(TotCarpetas);
  until FindNext(Arch)<>0;
  FindClose(Arch);
end; 

function TForm1.GetOpciones: Byte;
begin
  if (cbDirectorios.Checked and cbOcultos.Checked) then Result:=0;
  if (cbDirectorios.Checked and not(cbOcultos.Checked)) then Result:=1;
  if ((not(cbDirectorios.Checked)) and (not(cbOcultos.Checked))) then Result:=2;
  if ((not(cbDirectorios.Checked)) and cbOcultos.Checked) then Result:=3;
end;    

Lo primero importante que hace el procedimiento MostrarArchivos es llamar a la función GetOpciones para saber la selección del usuario en cuanto a qué mostrar. Con el resultado obtenido se continúa con el CASE OF y la primera (y única) llamada a FindFirst, esto es importante, si debemos utilizar nuevamente FindFirst, antes debemos utilizar FindClose.

FindFirst(arbol.Path+'*',faHidden or faDirectory,Arch)<>0 then Exit;

He visto varios ejemplos así: If FindFirst('*',faAnyFile and faDirectory,... etc.
faAnyFile no es necesario.
Otra aclaración: es común pensar que FindFirst se fija en que se cumpla lo especificado en attr para devolver un resultado, pues esto no es tan así, attr son valores adicionales, significa que el resultado será un archivo normal o que tenga los atributos especificados en attr. Por eso, al llamar a FindFirst(arbol.Path+'*',faHidden or faDirectory,Arch) si encuentra un archivo normal, devolverá 0 (cero) y el registro Arch con la información del mismo.

repeat
  ...
until FindNext(Arch)<>0;
FindClose(Arch);

Al primer ciclo de repeat until entramos con el registro que completó FindFirst, en las siguientes iteraciones lo hacemos con el registro que devolvió FindNext y finalmente cerramos la búsqueda. Todo esto se ejecuta cada vez que se cambia de directorio en el árbol (que solo muestra directorios).

Todo el código:

unit principal;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, LCLIntf, Graphics, Dialogs, ShellCtrls, Buttons,
  StdCtrls, ComCtrls, ExtCtrls, Interfaces;

type

  { TForm1 }

  TForm1 = class(TForm)
    BSalir: TBitBtn;
    cbOcultos: TCheckBox;
    cbDirectorios: TCheckBox;
    Label1: TLabel;
    Label2: TLabel;
    lTotArch: TLabel;
    Label4: TLabel;
    lTotSubDir: TLabel;
    lTam: TLabel;
    arbol: TShellTreeView;
    Memo1: TMemo;
    Panel1: TPanel;
    Panel2: TPanel;
    Splitter1: TSplitter;
    procedure arbolClick(Sender: TObject);
    procedure BSalirClick(Sender: TObject);
    procedure cbDirectoriosChange(Sender: TObject);
    procedure cbOcultosChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    procedure SetPath;
    procedure MostrarArchivos;
    {//0 Dir y Oc - 1 Dir - 2 No Dir y No Oc - 3 No Dir y Oc}
    function GetOpciones:Byte;
    function Tamanio(var sDenominacion: String; nByte: Int64):Single;
  public

  end;


var
  Form1: TForm1;
  APath:String;
  ARoot:String;
  ind:Integer;
  opciones:Byte;
  TotArchivos:Integer=0;
  TotCarpetas:Integer=0;
  TotTamanio:Int64=0;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  SetPath;
  arbol.Path:=APath;   //le agrega un pathdelimiter al final de aPath
  MostrarArchivos;
  Label1.Caption:=arbol.Path;
end;

procedure TForm1.MostrarArchivos;
var
  Arch:TSearchRec;
  den:String='';
  linea:String='';
begin
  TotArchivos:=0;
  TotCarpetas:=0;
  TotTamanio:=0;
  Memo1.Clear;
  opciones:=GetOpciones;
  case opciones of
    0 : if FindFirst(arbol.Path+'*',faHidden or faDirectory,Arch)<>0 then Exit;  //Si encontró devuelve 0 cero.
    1 : if FindFirst(arbol.Path+'*',faDirectory,Arch)<>0 then Exit;
    2 : if FindFirst(arbol.Path+'*',not faHidden and not faDirectory,Arch)<>0 then Exit;
    3 : if FindFirst(arbol.Path+'*',faHidden and not faDirectory,Arch)<>0 then Exit;
  end;
  repeat
    if ((Arch.Name<>'.') and (Arch.Name<>'..')) then
    begin
      linea:=Format('%0:-40s',[' '+Arch.Name]);
      if (Arch.Attr and  faDirectory)<>0 then
        begin
          linea:=linea+Format('%0:12s',['[Dir]']);
          Inc(TotCarpetas);
        end
      else
        begin
          linea:=linea+Format('%8.2n',[Tamanio(den,Arch.Size)])+Format('%0:4s',[den]);
          Inc(TotArchivos);
          TotTamanio:=TotTamanio+Arch.Size;
        end;
      linea:=linea+Format('%0:20s',[DateTimeToStr(FileDateToDateTime(Arch.Time))]);
      Memo1.Lines.Add(linea);
    end;
    lTotArch.Caption:=IntToStr(TotArchivos);
    lTam.Caption:=FormatFloat('0.00',(Tamanio(den,TotTamanio)))+' '+den;
    lTotSubDir.Caption:=IntToStr(TotCarpetas);
  until FindNext(Arch)<>0;
  FindClose(Arch);
end;

function TForm1.GetOpciones: Byte;
begin
  if (cbDirectorios.Checked and cbOcultos.Checked) then Result:=0;
  if (cbDirectorios.Checked and not(cbOcultos.Checked)) then Result:=1;
  if ((not(cbDirectorios.Checked)) and (not(cbOcultos.Checked))) then Result:=2;
  if ((not(cbDirectorios.Checked)) and cbOcultos.Checked) then Result:=3;
end;

function TForm1.Tamanio(var sDenominacion: String; nByte: Int64): Single;
CONST
  KBytes=1024;
  MBytes=1024*1024;
  GBytes=1024*1024*1024;
  TBytes=1024*1024*1024*1024;
  PBytes=1024*1024*1024*1024*1024;
begin
  case nByte of
    0..KBytes-1 : begin
                    sDenominacion:='B';
                    Result:=nByte;
                  end;
    KBytes..MBytes-1 : begin
                         sDenominacion:='KB';
                         Result:=nByte/KBytes;
                       end;
    MBytes..GBytes-1 : begin
                         sDenominacion:='MB';
                         Result:=nByte/MBytes;
                       end;
    GBytes..TBytes-1 : begin
                         sDenominacion:='GB';
                         Result:=nByte/GBytes;
                       end;
    TBytes..PBytes-1 : begin
                         sDenominacion:='TB';
                         Result:=nByte/TBytes;
                       end;
  else
    begin
      sDenominacion:='??';
      Result:=1;
    end;
  end;
end;


procedure TForm1.SetPath;
begin
  {$IFDEF WINDOWS}
  APath:=ExtractFilePath(Application.Location);
  {$ELSE}
  APath:=GetEnvironmentVariable('HOME');
  ARoot:=APath;
  //arbol.Root:=ARoot; Si queremos que la raíz del árbol sea la home del usuario.
  {$ENDIF}
end;

procedure TForm1.BSalirClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.cbDirectoriosChange(Sender: TObject);
begin
  MostrarArchivos;
end;

procedure TForm1.cbOcultosChange(Sender: TObject);
begin
  MostrarArchivos;
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  CloseAction:=caFree;
end;

procedure TForm1.arbolClick(Sender: TObject);
begin
  if not Assigned(arbol.Selected) then Exit;
  Label1.Caption:=arbol.Path;
  MostrarArchivos;
end;

end.

Descargar todo el proyecto: Mostrar archivos con FindFirst.7z

TTreeView con nodos y punteros TTreeNode.Data

En la entrada anterior vimos las operaciones básicas de un TreeView solo con ítems, ahora veremos con nodos, que ya sirve de algo, con punteros a objetos, más precisamente a un registro, que es apuntado por TreeNode.Data siendo Data del tipo Pointer y, siendo Pointer un puntero sin tipo. En el programa de ejemplo se muestra como agregar un nodo raíz, un nodo hijo, el índice absoluto, modificar los datos de un registro de un nodo, borrar un nodo, mostrar los datos del registro apuntado por un nodo. Para el caso, los nodos raíz, no pueden apuntar a un objeto, solo a hojas (nodos), para el caso que se necesite que lo nodos de nivel cero tengan un registro (apunten a un registro), ya que no se puede, lo que se hace es se crea un único nodo raíz y se lo oculta, de esta forma todos los nodos parten del nivel 1 y son hijos de ese único nodo padre. En este ejemplo se parte de dos nodos raíces a los cuales el usuario le agrega nodos hijos, nietos, etc. y todos tienen el mismo tipo de registro, lo cual no es obligatorio; en este ejemplo un nodo raíz se llama "profesores" y el otro "alumnos", los nodos de ambos apuntan el mismo tipo de registro pero bien se puede crear un registro para profesores y otro para alumnos.

Como se ve en la imagen, se utilizan: un TTreeView, 5 TEdit, 4 TLabel y 5 botones.

Le agregamos 2 elementos al árbol, nodos de nivel 0 (cero), todas la operaciones que se hagan, serán sobre los nodos que "cuelguen" de estos dos.

type
PRegistro=^TRegistro;

TRegistro=record
  documento:string;
  nacionalidad:string;
  estadocivil:string;
end;

Definimos un registro y un puntero a dicho registro.

Agregar nodo:

procedure TForm1.BAgregarClick(Sender: TObject);
var
  RegPtr:PRegistro;
begin
  New(RegPtr);
  RegPtr^.documento:=edDocumento.Text;
  RegPtr^.nacionalidad:=edNacionalidad.Text;
  RegPtr^.estadocivil:=edEstadoCivil.Text;
  if (tv.Items.Count=0) or (tv.Selected=nil) then
    tv.Items.Add (nil, edNombre.Text)
  else
   tv.Items.AddChildObject(tv.Selected, edNombre.Text, RegPtr);
end;

Declaramos una variable local del tipo PRegistro (puntero al registro) y con New la instanciamos. Es decir, tenemos una nueva dirección de memoria y espacio para nuestro nuevo registro, luego le asignamos los datos. Ahora a ese registro que está "flotando" en la memoria RAM, hay que enlazarlo al árbol, y esto se hace asignando a la propiedad Data del nodo, la dirección de memoria donde se aloja el registro, eso lo hacemos mediante AddChildObject (nodopadre, textoamostrar, punteroalregistro). La parte True del if es para agregar un elemento raíz, si se agrega sin haber seleccionado un nodo, creará un ítem nivel 0.

Borrar un nodo:

procedure TForm1.BBorrarNodoClick(Sender: TObject);
begin
  if tv.Selected=nil then Exit;
  tv.Selected.Delete;
  BorroEdit; //Procedimiento que borrar los TEdit.
end;

Siempre averiguar si hay algún nodo seleccionado para evitar errores.

Modificar un nodo:

procedure TForm1.BModificarClick(Sender: TObject);
begin
  if tv.Selected=nil then Exit;
  edNombre.Text:=tv.Selected.Text;
  edDocumento.Text:=PRegistro(tv.Selected.Data)^.documento;
  edNacionalidad.Text:=PRegistro(tv.Selected.Data)^.nacionalidad;
  edEstadoCivil.Text:=PRegistro(tv.Selected.Data)^.estadocivil;
end;

En esta primera parte se carga el registro apuntado por el nodo en los TEdit. Como vemos no es necesario crear una variable local del tipo puntero a TRegsitro, se utiliza PRegistro(puntero)^.campo.

procedure TForm1.BActualizarClick(Sender: TObject);
begin
  if tv.Selected=nil then Exit;
  if tv.Selected.Level < 1 then Exit; 
  tv.Selected.Text:=edNombre.Text;      
  PRegistro(tv.Selected.Data)^.documento:=edDocumento.Text;  
  PRegistro(tv.Selected.Data)^.nacionalidad:=edNacionalidad.Text; 
  PRegistro(tv.Selected.Data)^.estadocivil:=edEstadoCivil.Text; 
end;

Cuando puslamos el botón Actualizar, lo que está en los TEdit, lo asignamos al registro; previamente hacemos las validaciones mínimas del caso, ya que solo es un ejemplo.

Ver el registro apuntado por un nodo:

procedure TForm1.BVerClick(Sender: TObject);
begin
  if tv.Items.Count < 1 then Exit;
  if tv.Selected=nil then exit;
  if (tv.Selected.Data < > nil) then
  begin
    lNombre2.Caption:=tv.Selected.Text;
    lDocumento.Caption:=PRegistro(tv.Selected.Data)^.documento;
    lNacionalidad.Caption:=PRegistro(tv.Selected.Data)^.nacionalidad;
    lEstadoCivil.Caption:=PRegistro(tv.Selected.Data)^.estadocivil;
  end;
end;

Mostramos el contenido del registro en los TLabel. Como siempre, validar antes de ejecutar la acción.

procedure TForm1.tvChange(Sender: TObject; Node: TTreeNode);
begin
  if (not(Assigned(Node)) or (Node.Level < 1)) then Exit;
  edNombre.Text:=tv.Selected.Text;
  edDocumento.Text:=PRegistro(tv.Selected.Data)^.documento;  
  edNacionalidad.Text:=PRegistro(tv.Selected.Data)^.nacionalidad;
  edEstadoCivil.Text:=PRegistro(tv.Selected.Data)^.estadocivil;
end;


En este caso cargamos los TEdit con el registro del nodo al cual se le ha hecho click y atención, no usamos el evento OnClick sino el evento OnChange que se lanza o dispara cuando cambia el nodo seleccionado. Es importante la validación previa, si el Node, que viene como parámetro, no está asignado o es de nivel 0, entonces "huímos".
Al implementar este método ya no sería necesario el botón modificar que carga los TEdit.

Ver el índice absoluto de un nodo:

procedure TForm1.BVerIndiceClick(Sender: TObject);
begin
  if tv.Selected=nil then exit;
  Edit4.Text := IntToStr(tv.Selected.AbsoluteIndex);
end;

Cada nodo tiene un índice absoluto dentro de un árbol, independientemente de su nivel (level), vendría a ser un identificador único.

Video:



Código fuente del proyecto: TTreeView_Nodos.7z