viernes, 20 de diciembre de 2019

El temporizador TIdleTimer

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.    

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.

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

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