Mostrando entradas con la etiqueta Free Pascal. Mostrar todas las entradas
Mostrando entradas con la etiqueta Free Pascal. Mostrar todas las entradas

viernes, 12 de octubre de 2012

Llenando un Treeview desde un directorio en lazarus (Linux/Windows)

Bueno vengo a poner un ejemplo sencillo de como llenar un Treeview desde un directorio en Lazarus, algo curioso que note al portarlo a Linux y OsX es que el valor que la constante "faDirectory" en Windows toma un valor de "16" y en SO "Unix" toma el valor de "48" por ese detalle al principio no me listaba los directorios, después de ir viendo paso por paso los valores que tomaban me di cuenta de eso, solo agregamos una validación que identifique el SO en el que se esta ejecutando y ajustar ese valor.

En el ejemplo agregamos al evento OnClick de un botón el siguiente código:

procedure TfrmMain.btnAgregaMarcadorClick(Sender: TObject);
var
    lcSearch: TSearchRec;
    lcFileAttr: integer;
    lcFatherNode: TTreeNode;
    lcChildNode: TTreeNode;
    lcPath: String;
begin
    {$IFDEF UNIX}
        lcFileAttr:= 48;
    {$ELSE}
        lcFileAttr:= faDirectory;
    {$ENDIF}
    SelectDirectoryDialog1.Execute;
    lcPath:=SelectDirectoryDialog1.FileName;
    if Length(lcPath) > 0 then begin
        lcFatherNode:= TTreeNode.Create(TreeView1.Items);
        lcFatherNode:= TreeView1.Items.AddChild(TreeNodeRoot,lcPath);
        lcFatherNode.ImageIndex:=0;
        lcFatherNode.SelectedIndex:=0;
        lcFatherNode.Expanded:=True;
    end;
    lcPath:=lcPath+PathDelim;
    If FindFirst(lcPath+'*',faDirectory,lcSearch)=0 then begin
        repeat
            if lcSearch.Attr = lcFileAttr then begin
                if (lcSearch.Name = '.') or (lcSearch.Name = '..') then continue;
                lcChildNode:= TreeView1.Items.AddChild(lcFatherNode,lcSearch.Name);
                lcChildNode.ImageIndex:=0;
                lcChildNode.SelectedIndex:=0;
                AddDirectorios(lcChildNode,lcPath+lcSearch.Name);
            end;
        until FindNext(lcSearch) <> 0;
        FindClose(lcSearch);
    end;
   TreeView1.Refresh;
end;

El siguiente procedimiento lo agregamos nosotros, este será llamado desde nuestro anterior proceso cuando encuentre un directorio, y será llamado recursivamente desde él mismo agregando los nodos hijos con el nombre de los directorios encontrados.

procedure TfrmMain.AddDirectorios(elNodo: TTreeNode; cPath: String);
var
    sr: TSearchRec;
    lcFileAttr: Integer;
    theNewNode : tTreeNode;
begin
    {$IFDEF UNIX}
        lcFileAttr:= 48;
    {$ELSE}
        lcFileAttr:= faDirectory;
    {$ENDIF}

    if FindFirst(cPath+PathDelim+'*', faDirectory, sr) = 0 then begin
        repeat
            if sr.Attr = lcFileAttr then begin
                if (sr.Name = '.') or (sr.Name = '..') then continue;
                    theNewNode := TreeView1.Items.AddChild(elNodo,sr.name);
                    theNewNode.ImageIndex:=0;
                    theNewNode.SelectedIndex:=0;
                    AddDirectorios(theNewNode,cPath+PathDelim+sr.Name);
            end;
        until FindNext(sr) <> 0;
        FindClose(sr);
    end;
end;

viernes, 5 de octubre de 2012

Ejemplo sencillo usando Hilos (Threads) con Lazarus 1.0 en Linux (Ubuntu12.04)

Bueno, buscando mejorar el rendimiento de una aplicación que estoy desarrollando *mientras aprendo* usando el IDE Lazarus, supuse que lo mejor sería usar hilos para ciertos procesos de la aplicación que pueden llegar a ser pesados, al ver y probar algunos ejemplos de multithreading en windows vi que era la solución, todo bien, estuve probando y experimentando y funcionaba de lo lindo en windows, al compilarlo en Linux, todo compilaba bien... solo que al llegar a crear el hilo saltaba una excepción fatal!



Revisando el código, probando linea por linea, comparándolo con el ejemplo de multi threading que viene con Lazarus, no encontraba el error, usaba lo que tenía que usar, todo en su lugar... eso creía yo.

Esto es una sugerencia basada en mi experiencia: Si preguntan en algún foro, y esperan una respuesta rápida, pregunten en foros en idioma Inglés, cuando he preguntado en foros en español, o no me contestan, o tardan millones de años.

Bueno lancé la pregunta en el foro de Lazarus y en Stack Overflow, minutos mas tarde ya me estaban respondiendo con algunos tips, y comentarios de lo que podría estar fallando o faltando en mi proyecto.

En resumen la cuestión era que si se van a usar threads en Linux(UNIX, OsX  BSD y demás) es necesario agregar al archivo ".lpr" del proyecto (este archivo es creado automaticamente al crear un proyecto, en el directorio del proyecto) necesitamos agregar la siguiente linea:

{$define UseCThreads}

Quedando de la siguiente forma el documento:


{$mode objfpc}{$H+}
{$define UseCThreads}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
  Forms, Unit1
  { you can add units after this };
  .
  .
  .

Una vez agregado esto y recompilando, funcionó.

Bueno voy a agregar el pequeño ejemplo:
Comienzan un nuevo proyecto en Lazarus->aplicación, y agregara un form vacío, agregamos un botón y un progressbar para el ejemplo.


unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ComCtrls;

//Creamos el type para lo que será nuestro hilo
type

{ TMiHilo }

  TMiHilo = class(TThread)
  private
    procedure AvanzaBarra;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: boolean);
  end;     

{ TForm1 }
  TForm1 = class(TForm)
    Button1: TButton;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;         

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }
//agregamos al evento click del botón, aquí se iniciará nuestro hilo al dar click
procedure TForm1.Button1Click(Sender: TObject);
var
    MiHilo : TMiHilo;
    begin
        //creamos el hilo, pero no lo iniciamos
        MiHilo := TMiHilo.Create(True); // Con el parametro true no se inicia automaticamente
        if Assigned(MiHilo.FatalException) then
           raise MiHilo.FatalException;
        //si no hay ninguna excepción lo iniciamos
        MiHilo.Start;
end;

//aquí definimos los procesos para el hilo
{ TMiHilo }

procedure TMiHilo.AvanzaBarra;
//Este metodo solo es llamado por Synchronize(@AvanzaBarra) y por ello
// es ejecutado por el hilo principal.
//El hilo principal puede acceder a los elementos visuales del GUI por ejemplo a la progressbar 
begin
    Form1.ProgressBar1.StepIt;

    if Form1.ProgressBar1.Position = Form1.ProgressBar1.Max then begin
        Form1.ProgressBar1.Position := 0;
    end;
end;

//Este proceso se ejecuta al iniciar el hilo
procedure TMiHilo.Execute;
begin
    
    //mientras no termine y sea verdadero se ejecutará 
    while (not Terminated) and (true) do begin
        //este loop es del hilo principal 
        Synchronize(@AvanzaBarra);
    end;
end;

constructor TMiHilo.Create(CreateSuspended: boolean);
begin
    //Con esta propieda del hilo no necesitamos liberarlo manualmente al terminar de ejecutar el hilo
    FreeOnTerminate := True;
    inherited Create(CreateSuspended);
end;


end.

Y listo, compilamos y ejecutamos y debemos ver nuestro formulario con un botón y una barra de progreso, al dar clic en el botón esta comenzará a llenarse, cuando se llene se vaciará y comenzara de nuevo. No olviden agregar la linea {$define UseCThreads} en el archivo .lpr de su proyecto para que la validación de "si es compilado en Unix" use cThreads.


jueves, 20 de septiembre de 2012

Desarrollo multiplataforma con Lazarus (Clon de Delphi)

¿Que es Lazarus?

Bueno en su página podemos encontrar lo siguiente:
Lazarus es el conjunto de bibliotecas de clases para el compilador Free Pascal que emula a Delphi. Free Pascal es un compilador de licencia GPL que trabaja sobre Linux, Windows, OsX, OS/2, 68k y más.
Lo interesante de esto es que podemos crear nuestro proyecto en cualquier plataforma y solo tendremos que compilarla en otras para mudarla. Como ejemplo, creamos un proyecto en Windows con componentes normales de este, para migrarlo a Linux solo tenemos que mover el proyecto al equipo con Linux y Lazarus instalado, seleccionar que conjunto de widgets queremos utilizar (GTK o Qt para Linux) y compilarlo, Lazarus se encargará de todo, no tenemos que reescribir nuestro código.

A diferencia de Java que es "compilalo una vez ejecútalo donde sea", con Lazarus lo escribimos una vez y lo compilamos donde queramos".

En cuanto al lenguaje, como se menciono es un clon de Delphi, entonces para los que usaron esta herramienta, será muy familiar para ellos.

A finales del mes pasado (Agosto) acaban de liberar la versión 1.0 de esta herramienta.
Podemos ver las notas de cambios aqui:  http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes 

Acá unas imágenes de como se ve trabajando en Linux 


Y acá imágenes del mismo proyecto compilado en Windows:


La herramienta esta muy completa, se encarga de hacer los bindings para la interfaz, tiene soporte nativo para bases de datos, MySQL, PostgreSQL, SQL Sever y más, y es multiplataforma, así que vale la pena probarlo. 

Para Ubuntu/Mint no esta en los repositorios oficiales y desafortunadamente no cuenta con un ppa, pero en la página de descargas ofrecen los paquetes DEB con los que podemos instalarlos fácilmente.


Sitio principal de Lazarus: http://www.lazarus.freepascal.org/