Según la documentación oficial es "Un temporizador para medir el tiempo de inactividad entre procesos." y hereda la mayoría de sus propiedades de la clase TCustomTimer, aunque la clase base es TCustomIdleTimer.
Es como un TTimer pero con más opciones.
Se encuentra en la paleta Systems de Lazarus.
En el siguiente ejemplo haremos que el formulario se oculte por 10 segundos cuando el usuario hace click en el botón, luego de trascurrido dicho lapso, el formulario se muestra nuevamente.
procedure TForm1.FormCreate(Sender: TObject);
begin
IdleTimer1.Enabled:=False;
IdleTimer1.Interval:=10000;
end;
Esto también se puede hacer directamente en el inspector de objetos.
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
IdleTimer1.Enabled:=True;
Hide;
end;
Activamos el temporizador y ocultamos el formulario.
Desde el inspector de objetos, en eventos de IdleTimer1 definimos el evento OnTimer que es cuando el tiempo estipulado ya transcurrió.
procedure TForm1.IdleTimer1Timer(Sender: TObject);
begin
IdleTimer1.Enabled:=False;
Show;
end;
Es importante desactivar el temporizador, caso contrario seguirá ejecutándose.
El código completo:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
Buttons;
type
{ TForm1 }
TForm1 = class(TForm)
BitBtn1: TBitBtn;
IdleTimer1: TIdleTimer;
procedure BitBtn1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure IdleTimer1Timer(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
IdleTimer1.Enabled:=False;
IdleTimer1.Interval:=10000;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
IdleTimer1.Enabled:=True;
Hide;
end;
procedure TForm1.IdleTimer1Timer(Sender: TObject);
begin
IdleTimer1.Enabled:=False;
Show;
end;
end.
viernes, 20 de diciembre de 2019
lunes, 9 de diciembre de 2019
TListView: evitar ítems duplicados.
El componente TListView carece de una propiedad para impedir ítems duplicados, seguramente porque a su vez, los ítems son una clase que además posee subítems.
Una forma para evitar esta situación, sería, antes de agregar el ítem, recorrer la lista y comparar el texto (Caption) del ítem con los ya existentes, una función con un ciclo for to alcanza y es una manera correcta, pero si la lista tiene 15.000 ítems ¿que pasa?, para empezar, una lista del tipo TListView no debería contener tal cantidad y para terminar, también.
Pero TListView tiene un método (función) que hereda de TCustomListView: FindCaption.
{------------------------------------------------------------------------------}
{ TListItems FindCaption }
{------------------------------------------------------------------------------}
function TListItems.FindCaption(StartIndex: Integer; Value: string;
Partial, Inclusive, Wrap: Boolean; PartStart: Boolean): TListItem;
var
I: Integer;
CaptionFound, AllChecked: Boolean;
begin
result := nil;
if (Count = 0) or (StartIndex >= Count) or (not Inclusive and (count = 1)) then Exit;
CaptionFound := False;
AllChecked := False;
if Inclusive then
I := StartIndex
else begin
I := succ(StartIndex);
if I >= Count then I := 0;
end;
if Wrap then Wrap := (StartIndex <> 0);
repeat
if Partial then begin
if PartStart then
CaptionFound := pos(Value, Item[I].Caption) = 1
else
CaptionFound := pos(Value, Item[I].Caption) <> 0;
end else
CaptionFound := Value = Item[I].Caption;
if not CaptionFound then begin
Inc(I);
if Wrap then begin
if I = Count then
I := 0
else
if I = StartIndex then
AllChecked := True;
end else begin
if I = Count then AllChecked := True;
end;
end;
until CaptionFound or AllChecked;
if CaptionFound then result := Item[I];
end;
Las ventajas son las opciones y que ya está hecha.
¿Cómo utilizarla?
if Assigned(ListView1.FindCaption(0,'eltexto',False,True,False,True)) then Exit;
Este código debe ejecutarse antes de agregar un ítem, si el ítem ya existe, entonces FindCaption devuelve un ítem ("completo"), caso contrario, devuelve nil.
Para probarlo basta con este ejemplo:
unit principal;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
ExtCtrls, ShellCtrls, StdCtrls, Buttons;
type
{ TForm1 }
TForm1 = class(TForm)
BAgregar: TBitBtn;
lPath: TLabel;
Lista: TListView;
Panel1: TPanel;
arbol: TShellTreeView;
Splitter1: TSplitter;
procedure arbolClick(Sender: TObject);
procedure BAgregarClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
lPath.Caption:=arbol.Path;
end;
procedure TForm1.BAgregarClick(Sender: TObject);
var
li:TListItem;
begin
if not Assigned(arbol.Selected) then Exit;
if Assigned(Lista.FindCaption(0,arbol.Path,False,True,False,True)) then Exit;
li:=Lista.Items.Add;
li.Caption:=arbol.Path;
end;
procedure TForm1.arbolClick(Sender: TObject);
begin
if not Assigned(arbol.Selected) then Exit;
lPath.Caption:=arbol.Path;
end;
end.
Este programa agrega los nombres de las carpetas mostradas en un TShellTreeView a un TListView nombrada "lista" cada vez que se presiona el botón agregar, evitando duplicados.
Una forma para evitar esta situación, sería, antes de agregar el ítem, recorrer la lista y comparar el texto (Caption) del ítem con los ya existentes, una función con un ciclo for to alcanza y es una manera correcta, pero si la lista tiene 15.000 ítems ¿que pasa?, para empezar, una lista del tipo TListView no debería contener tal cantidad y para terminar, también.
Pero TListView tiene un método (función) que hereda de TCustomListView: FindCaption.
{------------------------------------------------------------------------------}
{ TListItems FindCaption }
{------------------------------------------------------------------------------}
function TListItems.FindCaption(StartIndex: Integer; Value: string;
Partial, Inclusive, Wrap: Boolean; PartStart: Boolean): TListItem;
var
I: Integer;
CaptionFound, AllChecked: Boolean;
begin
result := nil;
if (Count = 0) or (StartIndex >= Count) or (not Inclusive and (count = 1)) then Exit;
CaptionFound := False;
AllChecked := False;
if Inclusive then
I := StartIndex
else begin
I := succ(StartIndex);
if I >= Count then I := 0;
end;
if Wrap then Wrap := (StartIndex <> 0);
repeat
if Partial then begin
if PartStart then
CaptionFound := pos(Value, Item[I].Caption) = 1
else
CaptionFound := pos(Value, Item[I].Caption) <> 0;
end else
CaptionFound := Value = Item[I].Caption;
if not CaptionFound then begin
Inc(I);
if Wrap then begin
if I = Count then
I := 0
else
if I = StartIndex then
AllChecked := True;
end else begin
if I = Count then AllChecked := True;
end;
end;
until CaptionFound or AllChecked;
if CaptionFound then result := Item[I];
end;
Las ventajas son las opciones y que ya está hecha.
¿Cómo utilizarla?
if Assigned(ListView1.FindCaption(0,'eltexto',False,True,False,True)) then Exit;
Este código debe ejecutarse antes de agregar un ítem, si el ítem ya existe, entonces FindCaption devuelve un ítem ("completo"), caso contrario, devuelve nil.
Para probarlo basta con este ejemplo:
unit principal;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
ExtCtrls, ShellCtrls, StdCtrls, Buttons;
type
{ TForm1 }
TForm1 = class(TForm)
BAgregar: TBitBtn;
lPath: TLabel;
Lista: TListView;
Panel1: TPanel;
arbol: TShellTreeView;
Splitter1: TSplitter;
procedure arbolClick(Sender: TObject);
procedure BAgregarClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
lPath.Caption:=arbol.Path;
end;
procedure TForm1.BAgregarClick(Sender: TObject);
var
li:TListItem;
begin
if not Assigned(arbol.Selected) then Exit;
if Assigned(Lista.FindCaption(0,arbol.Path,False,True,False,True)) then Exit;
li:=Lista.Items.Add;
li.Caption:=arbol.Path;
end;
procedure TForm1.arbolClick(Sender: TObject);
begin
if not Assigned(arbol.Selected) then Exit;
lPath.Caption:=arbol.Path;
end;
end.
Este programa agrega los nombres de las carpetas mostradas en un TShellTreeView a un TListView nombrada "lista" cada vez que se presiona el botón agregar, evitando duplicados.
domingo, 8 de diciembre de 2019
TlistView con columnas e imágenes.
TListView puede contener varias columnas, las mismas se puede definir cómodamente desde el inspector de objetos "Columns" donde solo se especifica el nombre. Luego hay que valerse de items y subitems para cargar los datos en las respectivas columnas. Todo es texto (strings) tanto el nombre de las columnas, como el items y los subitems. Para agregar un ícono usamos una lista de imágenes TImageList y la asociamos a SmallImages en TListView. También el estilo (ViewStyle) de la lista debe ser vsReport.
Agregar columnas, como vemos, es simple.
En este ejemplo, la lista debe verse así, en la primer columna en nombre del archivo, la segunda el tamaño y la tercera la fecha y hora.
Hay que ajustar un poco la lista (TListView) desde el inspector de objetos:
TListView
AutoSort:=True
ColumnClick:=True
Columns:=3 items
ReadOnly:=True
ShowColumnHeader:=True
ScrollBars:=ssAutoBoth
SmallImages:=ImageList1
SortColumn:=0
ViewStyle:=vsReport
Y también la lista de imágenes (TImageList):
TImageList
Height:=24
Width:=24
Los imágenes para la lista:
La estructura de la lista:
Si trabajamos con columnas necesitamos una lista de ítems (TListItem) con la cual agregaremos los subítems:
Por ejemplo:
var
li:TListItem;
begin
li:=lista.Items.Add; //Crea el ítem y lo agrega a Lista (TListView)
li.Caption:='archivo.pas';
li.SubItems.Add('2772');
li.SubItems.Add('20-10-2018 15:30:58');
Como vemos no necesitamos instanciar la clase TListItem porque lo hace la función Add, su resultado es precisamente la instanciación de la variable:
function TListItems.Add: TListItem;
begin
if Assigned(Owner) then
Result := Owner.CreateListItem
else
Result := TListItem.Create(Self);
AddItem(Result);
end;
Siempre es bueno revisar el código fuente.
El código para llenar la lista es el siguiente:
procedure TForm1.MostrarArchivos;
var
Arch:TSearchRec;
li:TListItem;
den:String='';
begin
lista.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 //Evita los directorios ocultos en Linux
begin
li:=lista.Items.Add;
li.Caption:=Arch.Name;
if (Arch.Attr and faDirectory)<>0 then
begin
li.ImageIndex:=0;
li.SubItems.Add('--');
end
else
begin
li.ImageIndex:=1;
li.SubItems.Add(FormatFloat('0.00',Tamanio(den,Arch.Size))+' '+den);
end;
li.SubItems.Add(DateTimeToStr(FileDateToDateTime(Arch.Time)));
end;
until FindNext(Arch)<>0;
FindClose(Arch);
lista.Sort;
end;
La primer columna corresponde al texto del item, en este caso, li.Caption, las restantes son subitems y el texto se asigna mediante el métodos Add.
En cuanto a la imágenes que utilizamos como iconos las cargamos en li.ImageIndex siendo 0 para carpetas y 1 para archivos.
Para obtener los datos de una lista del tipo TListView también lo hacemos mediante la clase TListItem, por ejemplo:
li:=Lista.Items[i];
ShowMessage(li.Caption);
Descargar código fuente : TListView_Columns.7z
Agregar columnas, como vemos, es simple.
En este ejemplo, la lista debe verse así, en la primer columna en nombre del archivo, la segunda el tamaño y la tercera la fecha y hora.
Hay que ajustar un poco la lista (TListView) desde el inspector de objetos:
TListView
AutoSort:=True
ColumnClick:=True
Columns:=3 items
ReadOnly:=True
ShowColumnHeader:=True
ScrollBars:=ssAutoBoth
SmallImages:=ImageList1
SortColumn:=0
ViewStyle:=vsReport
Y también la lista de imágenes (TImageList):
TImageList
Height:=24
Width:=24
Los imágenes para la lista:
Si trabajamos con columnas necesitamos una lista de ítems (TListItem) con la cual agregaremos los subítems:
Por ejemplo:
var
li:TListItem;
begin
li:=lista.Items.Add; //Crea el ítem y lo agrega a Lista (TListView)
li.Caption:='archivo.pas';
li.SubItems.Add('2772');
li.SubItems.Add('20-10-2018 15:30:58');
Como vemos no necesitamos instanciar la clase TListItem porque lo hace la función Add, su resultado es precisamente la instanciación de la variable:
function TListItems.Add: TListItem;
begin
if Assigned(Owner) then
Result := Owner.CreateListItem
else
Result := TListItem.Create(Self);
AddItem(Result);
end;
Siempre es bueno revisar el código fuente.
El código para llenar la lista es el siguiente:
procedure TForm1.MostrarArchivos;
var
Arch:TSearchRec;
li:TListItem;
den:String='';
begin
lista.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 //Evita los directorios ocultos en Linux
begin
li:=lista.Items.Add;
li.Caption:=Arch.Name;
if (Arch.Attr and faDirectory)<>0 then
begin
li.ImageIndex:=0;
li.SubItems.Add('--');
end
else
begin
li.ImageIndex:=1;
li.SubItems.Add(FormatFloat('0.00',Tamanio(den,Arch.Size))+' '+den);
end;
li.SubItems.Add(DateTimeToStr(FileDateToDateTime(Arch.Time)));
end;
until FindNext(Arch)<>0;
FindClose(Arch);
lista.Sort;
end;
La primer columna corresponde al texto del item, en este caso, li.Caption, las restantes son subitems y el texto se asigna mediante el métodos Add.
En cuanto a la imágenes que utilizamos como iconos las cargamos en li.ImageIndex siendo 0 para carpetas y 1 para archivos.
Para obtener los datos de una lista del tipo TListView también lo hacemos mediante la clase TListItem, por ejemplo:
li:=Lista.Items[i];
ShowMessage(li.Caption);
Descargar código fuente : TListView_Columns.7z
domingo, 1 de diciembre de 2019
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
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
Etiquetas:
Assigned,
Attr,
FindClose,
FindFirst,
FindNext,
RawByteString,
TRawbyteSearchRec,
TShellTreeView
Suscribirse a:
Entradas (Atom)