lunes, 24 de septiembre de 2018

¿Cómo usar dos tablas de distintas bases de datos en la misma consulta?

Para adjuntar una tabla a un DataSet, en este caso TZQuery, y que no produzca un error, la solución que no encontré en ningún lado, la descubrí mediante el sistema de prueba y error hasta que salga. Y como suele suceder cuando no se encuentra algo en toda la web, es porque ese algo, es muy obvio y este caso no fue la excepción.

Primero establecemos la conexión con una de las dos bases de datos mediante el componente TZConnection. Luego hacemos una consulta para adjuntar la base de datos, la abrimos y la cerramos, listo, ya está adjuntada. Luego escribimos la consulta que necesitemos.

Ejemplo:

ZQ.Close;
ZQ.SQL.Text:='ATTACH DATABASE '+QuotedStr(strDB)+' AS realgestdb;';
ZQ.Open;
ZQ.Close;
ZQ.SQL.Text:='SELECT cfecha, cprovid, nombre, ccomp, realgestdb.comprob.ccomprobalias, cletracomp, '+
'cnrocomp, ccaeocai, ccai, cuit, cnetogravado, cnogravado, cimpinternos, cpercib, cperciva, ctasaiva, '+
'civa, cnetogravado1, ctasaiva1, civa1, cnetogravado2, ctasaiva2, civa2, ctotal '+
'FROM ccompras '+
'INNER JOIN cprov ON cprovid=provid '+
'INNER JOIN realgestdb.comprob ON ccomp=realgestdb.comprob.id '+
'WHERE cfecha BETWEEN '+QuotedStr(desde)+' AND '+QuotedStr(hasta)+
'ORDER BY cfecha, cprovid ;';
ZQ.Open;


Las tres primera lineas realizan el ATTACH DATABE y ya queda disponible para cualquier consulta que se realice en el mismo dataset, hasta que se des adjunte, para ello:

ZQ.Close;
ZQ.SQL.Text:='DETACH DATABASE '+QuotedStr('realgestdb')+';';
ZQ.Open;
ZQ.Close;


Es importante para adjuntar, enviar el path completo de la base de datos y entre comillas simples, para eso nada más cómodo que la función QuotedStr. En este caso strDB es una variable del tipo string que contiene el path completo de la base de datos a adjuntar. Luego con AS le establecemos un alias para luego referenciarla en las consultas SQL. El alias puede ser cualquier nombre.
Pero ojo, que para realizar el DETACH DATABASE se utiliza el Alias, no el path completo de la base de datos. Esto se debe que, al menos SQLite, permite adjuntar variar veces una misma base de datos bajo distintos Alias (AS).

La cuarta línea cierra la consulta. La quinta, cambia la consulta y para acceder al campo ccomprobalias de la tabla comprob de la base de datos adjuntada bajo el alias de realgestdb lo hacemos de la forma Alias.tabla.campo.

LazReport: cambiar el alto de una banda en tiempo de ejecución.


En este caso se trata de un reporte del libro I.V.A. y necesito cambiar el alto de la banda de los datos maestros según tengan 1, 2 o 3 discriminaciones o tasas de IVA en un mismo comprobante, para no desperdiciar espacio, entonces si un comprobante tiene un solo IVA el alto (height) será de 15, si son dos, será de 30 y si son tres será de 45 pixeles.
Como se ve en la imagen, durante el diseño del reporte se toma el máximo, será luego en run time que variará el valor de la banda MasterData1.

Para ello nos valemos del evento del reporte TfrReport OnBeginBand y su nombre lo indica todo: tareas a realizar al comienzo de la banda. Lo resolví muy simple de la siguiente manera:

procedure TFLibCompras.frRepBeginBand(Band: TfrBand);
begin
if ((Band.Name='MasterData1') and (ZQ.FieldByName('cnetogravado2').AsCurrency<>0)) then
  begin
    Band.Height:=45;
    Exit;
end;
if ((Band.Name='MasterData1') and (ZQ.FieldByName('cnetogravado1').AsCurrency<>0)) then
  begin
    Band.Height:=30;
    Exit;
  end;
if ((Band.Name='MasterData1') and (ZQ.FieldByName('cnetogravado1').AsCurrency=0)) then
  begin
    Band.Height:=15;
    Exit;
  end;
end;


El código es el que tengo funcionando y lo expongo a modo de ejemplo, la condición para establecer el alto de la banda puede ser cualquiera. También en el mismo evento podrían modificarse otros componentes del reporte.


Y así queda parte del reporte, con valores de prueba.

viernes, 17 de agosto de 2018

TMemo: evitar el enter.

Si bien una de sus propiedades es WantReturns y le podemos asignar False para evitar la línea nueva, a veces no funciona, al menos con la versión 1.6 de Lazarus y 3.0 de FreePascal usando el widget Gtk-2.
No obstante la solución es muy simple utilizando el evento OnKeyPress de TMemo:

procedure TForm1.mmDetalleKeyPress(Sender: TObject; var Key: char);
begin
  if (Key in [#13,#10]) then Key:=#0;
end;


mmDetalle es la variable del tipo TMemo.
Si la tecla presionada es Enter se anula.

TEdit: rellenar con ceros u otro caracter.

La función AddChar incluida en la unidad StrUtils hace esto.

function AddChar(C: Char; const S: string; N: Integer): string; 

El primer parámetro es el caracter con el cual vamos a rellenar los espacios del string, el segundo parámetro es el string a rellenar y el tercero la cantidad de lugares a rellenar (lo normal es que sea la misma cantidad de caracteres del string).

Ejemplo: un TEdit para que el usuario ingrese el número de un comprobante y al abandonar el TEdit, el mismo complete con ceros a la izquierda. Nos valemos del método OnExit del TEdit:

procedure TForm1.edNroExit(Sender: TObject);
begin
  edNro.Text:=AddChar('0',edNro.Text,8);
end;


El edNro es la variable del tipo TEdit y la propiedad MaxLength es 8, el resto de las propiedades son las predefinidas por el IDE Lazarus.
En lugar de pasar el número 8 se podría pasar la propiedad edNro.MaxLength.

jueves, 16 de agosto de 2018

TDBLookupComboBox: Validar.

Validar un combo del tipo TDBLookupComboBox con las siguientes propiedades:

Style: cdDropDown
ArrowKeysTravers: True
AutoComplete: True

Es una configuración muy cómoda para el usuario, pero permite que deje el valor del combo en blanco o con un valor que no coincide con ningún elemento, por el motivo que sea (distracción o "a ver que pasa").
Nota: para combos con pocos elementos conviene utilizar el estilo (style) csDropDownList y deshabilitar la propiedad de autocompletado.
Volviendo al tema de inicio, la validación se realiza a través del evento OnExit:

procedure TFCRegCompras.cmbProvExit(Sender: TObject);
begin
  if cmbProv.KeyValue=Null then
  begin
    ShowMessage('Seleccione un proveedor.');
    cmbProv.SetFocus;
  end;

end;

Desde ya es muy conveniente antes de cargar y habilitar el combo, verificar que el dataset no esté vacío, si esto sucediese, el programa no se colgaría, pero una vez que el usuario entra al combo, no podría salir nunca porque KeyValue siempre sería Null y al utilizar SetFocus vuelve a entrar al combo. Es una validación muy útil pero deben tomarse ciertas precauciones. Por ejemplo, en un programa de registración de compras, donde otros combos y valores dependen del proveedor seleccionado, usando el evento OnChange del combo de proveedores, es fundamental tomar este tipo de medidas.

lunes, 13 de agosto de 2018

TDBGrid: ordenar por columnas ASC y DESC con flechas.



Anteriormente escribí acerca de ordenar las columnas de un DBGrid de forma simple y en un solo sentido. Ahora veremos como hacerlo de forma tal que además de poner en negrita el título de la columna que posee el orden, le agregue una flecha ascendente (arriba) o una descendente (abajo) y que si el usuario hace click en el título de una columna y la misma es la que está ordenando la grilla, entonces cambie el orden de la misma, es decir, si está ordenada ascendentemente pasará a ordenarse en sentido descendente.

Para las flechas necesitamos un TImageList.


Este componente se encuentra en la paleta Common Controls (el último que se ve en la imagen).


Desde el inspector de objetos estableceremos las propiedades Height (alto) y Width (ancho) de ImageList1 en 16 pixeles. Luego cargamos las imágenes de las flechas en dicho componente.

Éstas son las flechas utilizadas:


Ahora debemos conectar la lista de imágenes con la grilla.


Seleccionamos el DBGrid en el inspector de objetos y en TitleImageList asignamos ImageList1. Luego en "Eventos" creamos el procedimiento para OnTitleClick:

procedure TForm1.DBGrid1TitleClick(Column: TColumn);
var
  i:Integer;
  AscDes:String;
begin
  if Column.Title.ImageIndex=0 then AscDes:=' DESC ' else AscDes:=' ASC ';
  for i:=0 to DBGrid1.Columns.Count-1 do
  begin
    DBGrid1.Columns.Items[i].Title.Font.Style:=[];
    DBGrid1.Columns.Items[i].Title.ImageIndex:=-1;
  end;
  ZQuery1.Close;
  sqlOrder:=' ORDER BY '+Column.FieldName+AscDes+';';
  sqlgrid:=sqlSelect+sqlWhere+sqlOrder;
  ZQuery1.SQL.Text:=sqlgrid;
  ZQuery1.Open;
  Column.Title.Font.Style:=[fsBold];
  if AscDes=' DESC ' then Column.Title.ImageIndex:=1 else Column.Title.ImageIndex:=0;
end;


Las variables sqlOrder, sqlGrid, sqlSelect y sqlWhere las defino como privadas para la clase del formulario, son del tipo string y su utilización es más que obvia, permitiendo por ejemplo, ordenar manteniendo un filtro definido por el usuario (sqlWhere).
Atención a no confundir Column con Columns, la primera viene como parámetro, es la columna en la cual el usuario hizo click. En cambio Column"s" es miembro de TDBgrid.
Lo primero que hacemos es averiguar si la columna (variable Column del tipo TColumn) está ordenada de manera descendente, caso contrario la damos como ascendente y establecemos el valor correspondiente a la variable local AscDes que luego utilizaremos en la consulta SQL.
Lo siguiente es recorrer las columnas (Columns) del grid y quitarles el [bold] y la flecha.
Cerramos el Query, armamos el string de la consulta y reabrimos la misma.
Finalmente marcamos en negrita el título de la columna y se asignamos la imagen de la flecha que le corresponde.










jueves, 5 de julio de 2018

TListBox: buscar.


El siguiente código se ejecuta cuando se presiona el botón buscar, si la cadena de texto ingresada coincide con algún ítem de la lista, el mismo es seleccionado.

procedure TFCProv.BBuscarClick(Sender: TObject);
var
  nombre, item:String;
  i, cant:Integer;
begin
  nombre:=UpperCase(edBuscar.Text);
  cant:=Length(nombre);
  for i:=0 to lbProv.Count-1 do
  begin
    item:=UpperCase(lbProv.Items[i]);
    if nombre=LeftStr(item,cant) then
    begin
      lbProv.ItemIndex:=i;
      Break;
    end;
  end;
end;


En este caso la lista contiene nombres de proveedores, está ordenada, convierte a mayúsculas la cadena a buscar y el elemento a comparar. La variable entera cant se utiliza para saber la cantidad de caracteres que ingresó el usuario y hacer la búsqueda parcial, es decir, si el usuario ingresa "Ac" y hay en la lista un elemento "ACME" se compara "AC" con "AC". Como lo que se quiere es solo marcar el elemento en la lista (lbProv.ItemIndex), se hace y se utiliza break para salir.

miércoles, 4 de julio de 2018

TDBLookupComboBox validar e impedir NULL.

Lo más simple es definir la propiedad Style en csDropDownList pero no siempre es lo que necesitamos. Por ejemplo cuando son muchos los registros que se cargan en el combo, le damos al usuario la posibilidad de que escriba las primeras letras y le traiga coincidencias, esto se logra estableciendo a True la propiedad AutoComplete. La contra es que el usuario puede abandonar el combo sin ninguna coincidencia, dejando el KeyValue (que es del tipo Variant) en Null. Esto a su vez lanzará un error si la validación la hacemos con números enteros, por ejemplo if combo.KeyValue<0 then...

Opción 1: no permitir que el usuario abandone el combo sin la correcta selección de un elemento.

Definir el evento OnExit.

procedure TFCProv.cmbLocalidadExit(Sender: TObject);
begin
  if cmbLocalidad.KeyValue=Null then
  begin
    ShowMessage('Seleccione una localidad.');
    cmbLocalidad.SetFocus;
  end;
end;


Opción 2: en algún caso en que se permite no seleccionar nada en el combo y debemos guardar 0 (cero) en la base de datos.


Por ejemplo, las actividades de 2 a 5 son opcionales y al crear el Form se les estable el valor de KeyValue en 0 para que no muestre nada. (La normalización y desnormalización de bases de datos está fuera del alcance de este ejemplo.).

if cmbActividad2.KeyValue=Null then
  DMProv.ZQProv.FieldByName('actividad2').AsInteger:=0
else
  DMProv.ZQProv.FieldByName('actividad2').AsInteger:=cmbActividad2.KeyValue;


Esta validación se hace al momento de guardar el registro y en todos los combos excepto el 1, si KeyValue es Null se guarda 0, caso contrario el valor de KeyValue.

TEdit solo números.

Para que una variable del tipo TEdit acepte solo números hay que definir el evento OnKeyPress de esta forma:

procedure TFCProv.edit1KeyPress(Sender: TObject; var Key: char);
begin
if not (Key in ['0'..'9',#8, #9]) then Key:=#0;
end;


De esta forma el usuario solo podrá ingresar números y borrar.

Si bien el tipo TEdit tiene una propiedad NumbersOnly, la misma no funciona si se utiliza el widget GTK-2 en sistemas operativos GNU con kernel Linux.

#8 es para permitir borrar y #9 la tecla de tabulación, cualquier otra tecla se anula con Key:=#0.

miércoles, 20 de junio de 2018

LazReport: cambiar el valor de numeración de las hojas.

En LazReport podemos utilizar la variable propia del generador de reportes [PAGE#] para imprimir el número de página, generalmente lo hacemos en la banda pie de página. De esta forma la primera página será la número 1 y las siguientes incrementarán su valor en 1.
Si queremos que la primera página tenga otro valor, podemos definir una variable en el reporte, en este caso llamada hojanumero y en el evento GetValue pasarle el valor que deseamos. Luego sumamos esta variable a [PAGE#] y le restamos 1.

En Lazarus podemos valernos cómodamente de un TSpinEdit para que el usuario ingrese el número inicial y establecemos los valores mínimos y máximos con lo cual nos ahorramos código de validación.


El valor de SpinEdit1.Value lo pasamos a la variable del reporte hojanumero.

En el reporte, añadimos un cuadro de texto en la banda pie de página e ingresamos lo siguiente:

Hoja N°[ ( [PAGE#] + [hojanumero] -1) ]

Otra opción es restarle 1 al valor antes de enviarlo al reporte y quitar el -1 de la fórmula anterior.

LazReport EVariantError

Un error muy común: Invalid variant  type cast, esta excepción puede ser lanzada por LazReport cuando utilizamos variables en el reporte que las enviamos mediante eventos como el típico GetValue.

Resulta que si bien Free Pascal no distingue entre mayúsculas y minúsculas, el componente LazReport sí lo hace con las variables del reporte, motivo que está fuera del alcance de esta entrada. En resumen, el string que utilizamos en dicho evento o cualquier otro evento de LazReport que utilice el par  de valores parname y parvalue, en parname debemos respetar las minúsculas.

Ejemplo del error:


Motivo del error:


En LazReport la variable está escrita toda en minúscula.


Mientras que en el evento está escrita combinando mayúsculas y minúsculas.

Solución: simplemente escribir correctamente la variable definida en el reporte, es decir todo en minúsculas, en este caso se cambia 'FechaReporte' por 'fechareporte'.

domingo, 17 de junio de 2018

TDBGrid: ordenar por columnas.

Ordenar los datos de una consulta SQL mostrados en un DBGrid al hacer click en la columna. En este caso además de ordenar, pondremos en bold (negrita) el título de la columna que está ordenada. (Para algo más avanzado aquí)

En el inspector de objetos, en DBGrid, eventos, buscar: OnTitleClick


y generar el evento (procedimiento):

procedure TFdCtas.DBGridCtasTitleClick(Column: TColumn);
var
  i:Integer;
begin
  for i:=0 to DBGridCtas.Columns.Count-1 do DBGridCtas.Columns.Items[i].Title.Font.Style:=[];
  ZQCtas.Close;
  ZQCtas.SQL.Text:='SELECT * FROM dcuentas ORDER BY '+Column.FieldName+';';
  ZQCtas.Open;
  Column.Title.Font.Style:=[fsBold];
end;


En el ciclo for quitamos "Bold" de todas las columnas y al final del código lo establecemos para la actual (que viene como parámetro).

Quedando así:



miércoles, 23 de mayo de 2018

TDataSource cuándo usarlo?

Lazarus, Free Pascal y muchos de sus componentes son sencillamente espectaculares, más aún teniendo en cuenta que es un proyecto de código abierto que comenzó hace muchos años (2001 creo), con pocos programadores para tamaño proyecto, actualmente entre Free Pascal y Lazarus, son unos 20.
El problema, lo dije desde un principio cuando retomé la programación, motivado por la existencia del IDE Lazarus, es la documentación, muchas veces inexistente y otras veces hay que dedicar mucho tiempo para dar con ella.
Los tutoriales para trabajar con bases de datos son pocos, algunos desactualizados y casi siempre los mismo ejemplos.
Es así como aprendí que para conectar y trabajar con una BD se necesitan 3 componentes: el conector (TZConnection), la consulta (TZQuery) y la fuente de datos (TDataSource). Pues no es así. Me di cuenta leyendo y participando del foro, cuando un usuario planteó una duda y detecté que en su código no utilizaba ningún TDataSource, le pregunté y me respondió si era necesario. Me sembró la duda y de hecho la respuesta es: No. Eso es cambia mucho mi panorama, para empezar no necesitaré tantos data modules si solo tengo un para de consultas, puedo declarar las conexiones y consultas sin necesidad de utilizar el data aware y que no molesten en el Form. Ahora entiendo por qué una vez me dijeron que cuando comienzas con esto, usas todo data aware y luego vas directamente por el código, y así es.

El data aware TDataSource solo es necesario cuando necesitamos enlazar los datos con un componente como puede ser un DBGrid, DBComboBox, etc. caso contrario no es necesario.

El ícono es muy claro, el componente envía los datos de un TDataSet hacia otros componentes, es indispensable para un TDBGrid por ejemplo, por eso es que el DataSource se debe vincular con un DataSet (y éste con un conector) y lo que alimenta al DBGrid es el DataSource. Ahora si no necesitamos alimentar ningún control, entonces no es necesario utilizar ningún DataSource.

jueves, 10 de mayo de 2018

SQL: Insertar registros en una tabla con campo auto increment.

¿Cómo ejecutar correctamente el comando SQL para insertar filas que contienen una columna auto incremental?

Por ejemplo, una tabla (tabla1) con 4 campos: id, nombre, apellido y edad.

CREATE TABLE tabla1 (id INTEGER UNIQUE NOT NULL PRIMARY KEY AUTOINCREMENT, nombre VARCHAR(50), apellido VARCHAR(50), edad INTEGER);

Error común:

INSERT INTO tabla1 VALUES ('Juan', 'Pérez', 25);

Esto arrojará un error del tipo "la tabla tiene 4 columnas pero solo se proporcionan 3 valores" y es cierto, pero claro, no se puede pasar el valor id porque el mismo debe establecerlo SQL.
La solución es simplemente especificar los campos:

INSERT INTO tabla1 (nombre, apellido, edad) VALUES ('Juan', 'Pérez', 25);

En caso de utilizar Zeos esto se realiza mediante ZConnection1.ExecuteDirect o también puede hacerse mediante el dataset ZQuery que sería algo así: (con la tabla ya creada)

ZQuery1.SQL.Text('SELECT * FROM tabla1;');
ZQuery1.Insert;
ZQuery1.FieldByName('nombre').AsString:='Juan';
ZQuery1.FieldByName('apellido').AsString:='Pérez';
ZQuery1.FieldByName('age').AsInteger:=25;
ZQuery1.Post

miércoles, 2 de mayo de 2018

Abrir documentos y URLs.

Las funciones para abrir archivos y páginas web se encuentran en la unidad LCLIntf la cual debe incluirse en uses.
OpenDocument: se le debe enviar el string con el nombre del archivo, retornará True si tuvo éxito o False en caso contrario. Esta función deriva la tarea al sistema operativo, el cual intentará abrir el archivo con el programa asociado según el tipo de archivo que sea. Ejemplo: OpenDocument('ayuda.pdf') abrirá el archivo ayuda.pdf que debe ubicarse en el directorio donde se encuentra el ejecutable. También se le puede pasar el path completo.
OpenURL: función similar que intentará que el navegador predeterminado se ejecute y vaya a la URL especificada. El string debe comenzar con 'http://' o 'https://'. Ejemplo: OpenURL('http://duckduckgo.com')

viernes, 13 de abril de 2018

Publicar proyecto


¿Para qué sirve esto? Para varias cosas, por ejemplo, para duplicar un proyecto o precisamente para publicar un proyecto. Lo de duplicar un proyecto se entiende, en cuanto a publicar, un ejemplo simple es para subirlo a un foro o ponerlo como descarga (primero publicar, luego comprimir).

Nota: el proceso de publicar proyecto no afecta en lo más mínimo al proyecto original.

Si usted participa de un foro de programación y le piden que adjunte el proyecto, pues bien, esto es lo que debe hacer:

Primero prepare un directorio vacío donde Lazarus publicará el proyecto.

Luego acceda a la opción desde el menú Proyecto.


En directorio de destino debemos establecer el que creamos para tal fin. Presionando sobre el botón con los tres puntos es la forma más práctica.
Si el proyecto tiene por ejemplo archivo de LazReport y queremos que se publiquen, los agregamos en los filtros a incluir "|lfr" y listo, aceptar.


Una ventana de diálogo nos advierte que si el directorio no está vacío se vaciará. Luego no habrá ningún mensaje de proyecto publicado ni nada, pero en el directorio especificado estarán todos los archivos. Se comprimen a formato 7z o zip y se publica. Es importante utilizar siempre 7z o zip en los foros de programación, especialmente el zip.

También sirve esto como copia de seguridad

domingo, 11 de marzo de 2018

Guardar y leer registros en archivos binarios.

Hay dos maneras de hacer esto, con AssingFile o con TFileStream. Prefiero AssingFile, pues se pueden hacer cosas que no se pueden con stream, por ejemplo mover el puntero hacia un registro (aunque solo en modo lectura) mediante el procedimiento Seek y también podemos usar la función FilePos para averiguar sobre qué registro está el puntero. Agregar datos a un archivo binario no se puede ni con AssigFile ni con FileStream, siempre debemos cargar los datos en memoria y re-escribir todo el archivo, lo cual hoy no es la gran cosa debido a la cantidad de sobra de memoria RAM que tiene cualquier ordenar y la velocidad de procesamiento.

En este ejemplo guardaremos registros con nombres de empresas, número ID y nombre de la base de datos, algo simple. Como buffer usaremos un array (vector o matriz unidimensional) de registros.

Código:

unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

    TForm1 = class(TForm)
    BGuardar: TButton;
    BLeer: TButton;
    BAgregar: TButton;
    edID: TEdit;
    EdEmpresa: TEdit;
    EdBD: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Memo1: TMemo;
    procedure BAgregarClick(Sender: TObject);
        procedure BGuardarClick(Sender: TObject);
      procedure BLeerClick(Sender: TObject);
        procedure FormCreate(Sender: TObject);
    private
        { private declarations }
    public
        { public declarations }
    end;
type
    TReg=record
      ID:Integer;
      Empresa:string[100];
      BD:string[100];
  end;

var
    Form1: TForm1;
    archivo:String;
    aReg:array[0..99] of TReg;
    cantReg:Integer;


implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  archivo:=GetCurrentDir+PathDelim+'datareg.bin';
  cantReg:=0;
  if FileExists(archivo) then BLeerClick(Sender);
  //Si el archivo existe lo carga al array
end;

procedure TForm1.BGuardarClick(Sender: TObject);
var
  FReg:File of TReg; //Archivo que contendrá registros tipo TReg
  i:Integer;
begin
  AssignFile(FReg,archivo);  //Vinculamos el archivo
  Rewrite(FReg);             //Lo vamos a sobreescribir
  for i:=0 to cantReg-1 do //Recorremos el array y lo escribimos
                           //con Write
  begin
    Write(FReg,aReg[i]);
 end;
  CloseFile(FReg);   //Cerramos el archivo
end;

procedure TForm1.BLeerClick(Sender: TObject);
var
  FReg:File of TReg; //Archivo que contendrá registros tipo TReg
  i:Integer;
begin
  AssignFile(FReg,archivo); //Vinculamos el archivo
  Reset(FReg); //Lo abrimos en modo solo lectura
  i:=0;
  while not (EOF(FReg)) do      //Lo cargamos al array
  begin
    Read(FReg,aReg[i]);
    Memo1.Lines.Add(IntToStr(aReg[i].ID)+' '+aReg[i].Empresa+' '+
    aReg[i].BD);
    Inc(i);
    Inc(cantReg);
  end;
  CloseFile(FReg);  //Cerramos el archivo
end;

procedure TForm1.BAgregarClick(Sender: TObject);
begin
  aReg[cantReg].ID:=StrToInt(edID.Text);//Agregamos solo al array, 
                                        //no al archivo.
  aReg[cantReg].Empresa:=EdEmpresa.Text;
  aReg[cantReg].BD:=EdBD.Text;
  Inc(cantReg);
  Memo1.Lines.Add('aReg['+IntToStr(cantReg-1)+']: '+EdEmpresa.Text);
end;

end.


En el registro debemos definir la longitud de los strings.
El primer registro de un archivo binario está en la posición 0 (cero).
No hay forma de agregar un registro a un archivo binario, como sí podemos hacerlo con archivos de texto plano, siempre ha que sobreescribir todo el archivo, de ahí ReWrite.
Al utilizar AssignFile podemos acceder mediante Seek a un determinado registro conociendo su posición y leerlo.

Código fuente:  archivosbinarios.7z (incluye e archivo binario con 5 registros).

o en GitLab



viernes, 9 de marzo de 2018

Cifrar y guardar en archivo binario.

Mucho se dice que no hay que guardar datos cifrados porque de una u otra forma pueden llegar a descifrarlos, máxime si dejamos el valor de la key o llave en nuestro programa. Y es cierto, pero no menos cierto es que es mucho mejor que dejar los datos sin encriptar en un archivo de texto o ini (que también es texto plano) o si se quiere en una tabla en SQLite, o también en un binario sin cifrar. Resumiendo es mejor cifrar. Y si además no guardamos la llave en el programa, sino que la requerimos al usuario (tampoco guardamos su hash), la única manera de obtener los datos es mediante el método de fuerza bruta, que tardará bastante con una llave de 30 caracteres con mayúsculas, minúsculas, números, espacios y símbolos, actualmente tardaría años.

En este ejemplo, para que se entienda bien, porque de eso tratan los ejemplos, cargaremos la llave en una variable. También cabe destacar que los nombres de variables y funciones que se ven en este ejemplo, son para aprender, en la práctica hay que esconder los datos, no usar para cifrar una función llamada cifrar, etc. También hay que validar datos y utilizar try al leer y escribir archivos.

Veamos el código:

unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

    TForm1 = class(TForm)
        BGuardar: TButton;
 BLeer: TButton;
 Edit1: TEdit;
 Edit2: TEdit;
 Edit3: TEdit;
 Edit4: TEdit;
 Edit5: TEdit;
 Edit6: TEdit;
 Label1: TLabel;
 Label2: TLabel;
 Label3: TLabel;
 Label4: TLabel;
 Label5: TLabel;
 Label6: TLabel;
 procedure BGuardarClick(Sender: TObject);
 procedure BLeerClick(Sender: TObject);
        procedure FormCreate(Sender: TObject);
    private
       function Cifrar (const texto:String):RawByteString;
       function DesCifrar (const texto:String):RawByteString;
        { private declarations }
    public
        { public declarations }
    end;

type
    TRegistro=Record
      Servidor:String[100];
      Usuario:String[100];
      Clave:String[100];
    end;

var
    Form1: TForm1;
    archivo:String;
    llave:String;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  archivo:=GetCurrentDir+PathDelim+'prueba.dat';
  llave:='La llave';
end;

function TForm1.Cifrar(const texto: String): RawByteString;
var
  str_Cifrar:TBlowFishEncryptStream;
  streamTexto:TStringStream;
begin
  streamTexto:=TStringStream.Create('');
  str_Cifrar:=TBlowFishEncryptStream.Create(llave,streamTexto);
  str_Cifrar.WriteAnsiString(texto);
  str_Cifrar.Free;
  Result:=streamTexto.DataString;
  streamTexto.Free;
end;

function TForm1.DesCifrar(const texto: String): RawByteString;
var
  str_DesCifrar:TBlowFishDeCryptStream;
  unstream:TStringStream;
  temp:RawByteString;
begin
  unstream:=TStringStream.Create(texto);
  unstream.Position:=0;
  str_DesCifrar:=TBlowFishDeCryptStream.Create(llave,unstream);
  temp:=str_DesCifrar.ReadAnsiString;
  str_DesCifrar.Free;
  unstream.Free;
  Result:=temp;
end;

procedure TForm1.BGuardarClick(Sender: TObject);
var
  Registro:TRegistro;
  FReg:File of TRegistro;
begin
  Registro.Servidor:=Cifrar(Edit1.text);
  Registro.Usuario:=Cifrar(Edit2.text);
  Registro.Clave:=Cifrar(Edit3.text);
  AssignFile(FReg,archivo);
  Rewrite(FReg);
  Write(FReg,Registro);
  CloseFile(FReg);
end;

procedure TForm1.BLeerClick(Sender: TObject);
var
  Registro:TRegistro;
  FReg:File of TRegistro;
begin
  AssignFile(FReg,archivo);
  Reset(FReg);
  Read(FReg,Registro);
  CloseFile(FReg);
  edit4.Text:=DesCifrar(Registro.Servidor);
  edit5.Text:=DesCifrar(Registro.Usuario);
  Edit6.Text:=DesCifrar(Registro.Clave);
end;

end.

Lo primero que debemos hacer es incluir la unidad BlowFish en uses.
Si trabajamos con archivos binarios, definimos un registro para guardar y leer los datos.
En el método Create simplemente definimos el archivo y la llave, que como ven, puede contener espacios.
Luego 2 funciones para encriptar y desencriptar y 2 procedimientos para guardar y leer, para un ejemplo, alcanza y sobra.

Veamos la función Cifrar:

function TForm1.Cifrar(const texto: String): RawByteString;
var
  str_Cifrar:TBlowFishEncryptStream;
  streamTexto:TStringStream;
begin
  streamTexto:=TStringStream.Create('');
  str_Cifrar:=TBlowFishEncryptStream.Create(llave,streamTexto);
  str_Cifrar.WriteAnsiString(texto);
  str_Cifrar.Free;
  Result:=streamTexto.DataString;
  streamTexto.Free;
end;

Nótese que no devuelve un string, sino un RawByteString que es una cadena de caracteres (string) sin ningún CodePage asociado, ideal e indispensable para que esto funcione.
Necesitamos dos variables, una para el stream de cifrado de Blow Fish y otro un stream común, donde volcaremos el texto cifrado.
Creamos el stream común (streamTexto) vacío.
Creamos el stream de cifrado de BF y le pasamos como parámetros la llave (establecida en FormCreate) y el stream de texto vacío. Es importante hacer todo en este orden.
Ahora ciframos con WriteAnsiString, como parámetro le pasamos la constante de la función llamada texto.
Liberamos el stream de cifrado, el texto cifrado está en el stream de texto (streamtexto).
Finalmente asignamos al resultado de la función el DataString del stream de texto y liberamos el mismo.

Ahora la función DesCifrar:

function TForm1.DesCifrar(const texto: String): RawByteString;
var
  str_DesCifrar:TBlowFishDeCryptStream;
  unstream:TStringStream;
  temp:RawByteString;
begin
  unstream:=TStringStream.Create(texto);
  unstream.Position:=0;
  str_DesCifrar:=TBlowFishDeCryptStream.Create(llave,unstream);
  temp:=str_DesCifrar.ReadAnsiString;
  str_DesCifrar.Free;
  unstream.Free;
  Result:=temp;
end;


También usamos dos variables para los streams y una tercera del tipo RawByteString que contendrá el valor que retornará la función. Podría obviarse esta variable supuestamente, pero por algo está ahí, la verdad no me acuerdo, algún error me habrá hecho intentar con una variable temporal, funcionó y ahí está.
Aquí cuando creamos el stream de texto, no lo hacemos vacío sino con el valor de la constante texto y a su vez, volvemos a cero su posición para que BF la lea desde el comienzo.
Creamos el stream de descifrado de BF y le pasamos también la llave y el stream de texto.
Ahora sí desciframos usando el método ReadAnsiString perteciente a TBlowFishDeCryptStream y lo asignamos a la variable temp; liberamos los streams y como resultado enviamos el valor de temp.

El resto del código no lo voy a explicar porque simplemente es usar estas dos funciones, escribir y leer el archivo binario de la manera habitual.

Descargar el código fuente: BlowFish.7z

o en GitLab


viernes, 9 de febrero de 2018

Guardar y leer imágenes en bases de datos.

Además de ver como se guarda una imagen de cualquier formato (JGP, PNG, etc.) en una base de datos SQL (SQLite en este caso), también veremos como leerla y mostrarla en un TImage en un formulario.
Logotipo: TImage;
Al TImage del Form1 lo llamamos Logotipo.
Para leer la imagen y mostrarla en un TImage en un Form:
procedure TFom1.CargoDatos;
var
  unstream:TMemoryStream;
begin
  //Se cargan la campos "normales"...
  if ZQuery1.FieldByName('logo').IsNull then
  begin
    Logotipo.Picture.Clear;
    Exit;
  end;
  unstream:=TMemoryStream.Create;
  unstream.Position:=0;
  TBlobField(ZQuery1.FieldByName('logo')).SaveToStream(unstream);
  unstream.Position:=0;
  Logotipo.Picture.LoadFromStream(unstream);
  unstream.Free;
end;
Declaramos una variable del tipo TMemoryStream donde almacenaremos el contenido de la imagen que se encuentra en el campo "logo" de una tabla.
Para no tener problemas, averiguamos si existe tal imagen, lo hacemos con FieldByName('logo').IsNull. Si esto devuelve True entonces borramos la imagen de LogoTipo, si no hacemos esto quedará la imagen cargada anteriormente si la hubiere. Si IsNull devuelve False quiere decir que hay una imagen (o debería haberla), entonces creamos el stream, lo posicionamos en 0 (cero) y lo cargamos con TBlobField(el campo).SaveToStream y cabe aclarar que no es necesario definir ninguna variable del tipo TBlobField, este procedimiento se encarga de todo. Ahora ya tenemos la imagen del campo logo de una tabla de una base de datos cargada en un stream de memoria, el paso final es mostrarla en el formulario, para eso posicionamos nuevamente a 0 (cero) el stream, y lo mandamos al TImage nombrado Logotipo y no olvidarse de liberar el stream utilizando el método Free.

Ahora lo inverso, leer la imagen y guardarla en la base de datos. Se omite la carga desde archivo en este ejemplo.
procedure TForm1.GuardarDatos(Sender: TObject);
var
  ms:TMemoryStream;
begin
  //Se pone el dataset en modo edit o insert y se graban los 
  //campos "normales"...
  if (logotipo.Picture.Width>0) then
    begin
      ms:=TMemoryStream.Create;
      Logotipo.Picture.SaveToStream(ms);
      ms.Position:=0;
      TBlobField(ZQuery1.FieldByName('logo')).LoadFromStream(ms);
      ms.Free;
    end
  else
    begin
      ZQuery1.FieldByName('logo').AsString:='';
    end;
  ZQuery1.Post;   
end;
Como en el código anterior, necesitamos una variable para el stream en memoria. Y nuevamente para no tener problemas, mediante Logotipo.Picture.Width>0 determinamos si hay alguna imagen que guardar, caso contrario se guarda NULL, AsString:='' hace eso.
Si hay imagen, creamos el stream y le asignamos la imagen que está contenida en la propiedad Picture de Logotipo (TImage). Posicionamos en 0 (cero) el stream que ya contiene la imagen y nuevamente nos valemos de TBlobField que asignará el stream al campo "logo" y liberamos con Free el stream.

Desde ya es un código orientativo, pero testeado que este método funciona, al menos para SQlite utilizando ZeosLib.

Hay muchas formas de hacer esto, pero esta forma es la que menos problemas me trajo y es bastante simple y "limpia". He probado antes con DBImage, pero a veces ejecutando el código desde la IDE me tiraba un error EReadError que podía ignorar y todo seguía bien, de hecho ejecutando el programa (fuera de la IDE) esos errores no se mostraban, hasta que detecté que si la imagen que leía DBImage no era JPG entonces largaba ese error, eso me motivo a deshacerme de TDBImage y hacerlo como lo muestro, básicamente con un stream, el procedimiento TBlobField y un TImage.

sábado, 3 de febrero de 2018

TDBLookUpComboBox validar OnExit

Cuando damos al usuario la posibilidad del autocompletado en un ComboBox y no validamos, existe la posibilidad de que salte un error y es correcto, porque siempre hay que validar. Por ejemplo puede pasar esto:


O esto otro:


que de paso, no puede pasar en el combo de bancos, porque es del tipo lista y de manera predeterminada ya seleccionamos el primer elemento, ahí no hay que validar nada, el usuario no puede hacer de las suyas. Pues bien, en cualquiera de los dos casos, si presiona imprimir y no se valida, el programa mostrará un mensaje de error. En cambio con una simple validación, obligamos al usuario a seleccionar un ítem del combo, mediante el evento OnExit:

procedure TFRepCuentas.cmbCtaExit(Sender: TObject);
begin
   if cmbCta.ItemIndex=-1 then
   begin
     ShowMessage('Debe seleccionar una cuenta.');
     cmbCta.SetFocus;
   end;
end;   

Entonces si el usuario lo deja en blanco o escribe xx (no coincidiendo xx con ningún elemento del combo) le aparecerá el siguiente mensaje y le enviará el cursor nuevamente al combo y de ahí no sale hasta que seleccione un ítem.


Y tendrá que seleccionar una cuenta sí o sí o cerrar la ventana (lo cual también podríamos evitar si quisiéramos).




sábado, 27 de enero de 2018

DBGrid: Anchors de las columnas

Si bien TDBGrid tiene la propiedad Anchors (Anclajes), cuando la definimos y agrandamos y achicamos el formulario, la grilla también lo hace, mas no sus columnas, la cuales carecen de la propiedad Anchors, entonces el ancho de las columnas permanece estático, no cambia.

¿Cómo hacer que las columnas cambien el ancho cuando se agranda el formulario que contiene la DBGrid?

Creando el evento FormResize y asignarlo a los eventos del Form OnResize y OnChangeBounds. Desde ya el grid debe estar anclado al formulario y tener definido al menos las constraints de valores mínimos. Luego, un poco de matemáticas y eso es todo.


Así tengo definido el anclaje del DBGrid, mucho no entiendo de este tema, mucho prueba y error hasta dar con el resultado que busco.


Las Constraints del DBGrid, aunque esto es relativo si están definidas las del Form.


En los eventos del DBGrid, desde el inspector de objetos, creamos el evento para OnResize y también lo asignamos a OnChangeBounds.

procedure TfrmBancos.FormResize(Sender: TObject);
var
  ndiv, nmod, ndist:Integer;
begin
  ndist:=(Width-Constraints.MinWidth);
  if ndist < 4 then exit;
  ndiv:=ndist div 4;
  nmod:=ndist mod 4;
  DBGrid1.Columns.Items[1].Width:=160+ndiv;
  DBGrid1.Columns.Items[2].Width:=120+ndiv;
  DBGrid1.Columns.Items[3].Width:=150+ndiv;
  DBGrid1.Columns.Items[4].Width:=160+ndiv;
  if nmod>0 then
    DBGrid1.Columns.Items[4].Width:=DBGrid1.Columns.Items[4].Width+nmod;
end;


En este caso, la columna 0 (cero) no la muestro, solo las 1,2,3 y 4 con un ancho definido en la propiedad width de cada columna de 160, 120, 150 y 160 respectivamente.
Lo que hago es calcular en cuántos píxeles se agranda el formulario y en base a ello, lo distribuyo en las columnas, como son 4, hago la división entera sobre 4 y el resto (mod) lógicamente también sobre 4. Luego elijo a que columna se asigno el sobrante si es que lo hay (mod 4).

jueves, 25 de enero de 2018

Enviar archivos a un servidor vía FTP


En este ejemplo vamos a enviar un archivo "listado.txt" que debe estar en la misma carpeta que el programa a un servidor remoto, es decir, necesitamos sí o sí un servidor al cual conectarnos vía FTP, y un usuario con privilegio de lectura y escritura. La conexión la hacemos por el puerto 21. Desde ya el archivo y el puerto se pueden cambiar desde el código fuente.
Necesitamos también el paquete synapse.

Descargar Synapse desde la web del autor: http://www.ararat.cz/synapse/doku.php/download

En la wiki de Free Pascal hay mucha información y ejemplos de Synapse (en inglés): http://wiki.freepascal.org/Synapse

Podemos utilizar este paquete sin necesidad de instalarlo ni reconstruir la IDE Lazarus.


Desde un proyecto nuevo o habiendo ya descargado es de este ejemplo (al final de esta entrada) vamos a Paquete y Abrir archivo de paquete .lpk.


El paquete se encuentra en la carpeta lib dentro de source donde se haya descomprimido synapse.


No tiene que aparecer esto.


Ahora tal cual se ve en la imagen, botón Usar y Agregar al proyecto, nada más, no se compila ni se instala.

Lo primero es incluir las unidades ftpsend y blcksock en la sección uses.

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


Al Form1 le vamos a definir dos variables privadas para que puedan ser accedidas desde los procedimientos (eventos/métodos).


private
  TotalBytes : longint;
  CurrentBytes : longint;


En la clase TForm vamos a incluir estos procedimientos:

procedure btnEnviarClick (Sender: TObject);
procedure btnSalirClick (Sender: TObject);
procedure FormCreate (Sender: TObject);
procedure SockCallBack (Sender: TObject; Reason: THookSocketReason; const Value: string);


FormCreate solamente hace los TEdit tipo password por lo tanto no es necesario para "practicar", o puede dejarse como password solo el correspondiente al TEdit de la contraseña.

edContrasena.EchoMode:=emPassword;
edServidor.EchoMode:=emPassword;
edUsuario.EchoMode:=emPassword;


El método SockCallBack solo es necesario para mostrar una barra de progreso.

case Reason of
  HR_WriteCount:


El enumerado HR_WriteCount se utiliza porque se envían archivos, si en cambio se recibieran archivos, el enumerado es otro, lo veremos en otra entrada donde explicare como recibir archivos vía FTP que desde ya, es parecido a esto.

Variables del evento btnEnviarClick:

procedure TForm1.btnEnviarClick(Sender: TObject);
var
  ftp: TFTPSend;
  remotefile: string;
  localfile: String;
  i: Integer;



Lo primero es definir una variable (en este caso llamada ftp) del tipo TFTPSend que se encuentra en la unidad ftpsend.pas. Si bien el nombre de esta unidad puede llevar a pensar que exista otra llamada ftpreciebe.pas, pues no, en ftpsend está todo, ya sea para enviar como para recibir archivos.

Luego de instanciar la variable "ftp" ftp := TFTPSend.Create; debemos "envolver" todo el código de conexión y envío del archivo en un try ... finally, no es obligatorio pero si recomendable.

ftp.DSock.OnStatus := @SockCallBack;

Es para incrementar la progressbar.

ftp.Timeout:=4000;

Esto es muy importante y lamentablemente no se menciona en la mayoría de ejemplos de FTPSend que hay en Internet. Si no definimos un tiempo de espera, el programa puede colgarse o largar un error, de esta forma establecemos en 4 segundo el tiempo de espera de respuesta del servidor.

if ftp.StoreFile(remotefile,False)

La función StoreFile es la que manda el archivo al servidor, el primer parámetros es un string que contiene la carpeta del servidor y el nombre del archivo /prueba/listado.txt y el segundo parámetro, booleano, solo debe ser True si el servidor soporta reanudar subidas, si es así solo se sube la parte que resta y si el tamaño del archivo es el mismo que el del archivo que está en el servidor, entonces no se envía nada. Como tercera opción, en caso de que el archivo del servidor sea más grande que el archivo local, entonces se envía todo el archivo desde el comienzo.

Todo el código:

unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

{ TForm1 }

TForm1 = class(TForm)
  btnEnviar: TButton;
  btnSalir: TButton;
  edCarpetaServidor: TEdit;
  edServidor: TEdit;
  edContrasena: TEdit;
  edUsuario: TEdit;
  Label1: TLabel;
  Label2: TLabel;
  Label3: TLabel;
  Label4: TLabel;
  MemoLog: TMemo;
  ProgressBar1: TProgressBar;
  procedure btnEnviarClick(Sender: TObject);
  procedure btnSalirClick(Sender: TObject);
  procedure FormCreate(Sender: TObject);
  procedure SockCallBack(Sender: TObject; Reason: THookSocketReason; const Value: string);
private
  TotalBytes : longint;
  CurrentBytes : longint;
{ private declarations }
public
{ public declarations }
end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.btnEnviarClick(Sender: TObject);
var
  ftp : TFTPSend;
  remotefile:string;
  localfile:String;
  i:Integer;
begin
  btnEnviar.Enabled:=False;
  btnSalir.Enabled:=False;
  ftp := TFTPSend.Create;
  localfile:='listado.txt';
  MemoLog.Lines.Add('Conectando con el servidor. Por favor espere.');
  Application.ProcessMessages;
  try
    ftp.DSock.OnStatus := @SockCallBack;
    ftp.Username:=edUsuario.Text;
    ftp.Password:=edContrasena.Text;
    ftp.TargetHost:=edServidor.Text;
    ftp.TargetPort:='21';
    ftp.Timeout:=4000;
    if ftp.Login then
      MemoLog.Lines.Add('Login: ********* correcto')
    else
      begin
        MemoLog.Lines.Add('Login: ********* incorrecto');
        exit;
    end;
    Application.ProcessMessages;
    Sleep(1000);
    remotefile:=edCarpetaServidor.Text+'listado.txt';
    Progressbar1.Position:=0;
    ftp.DirectFileName:=localfile;
    ftp.DirectFile:=true;
    TotalBytes:=FileSize(localfile);
    MemoLog.Lines.Add('Enviando archivo: ' + localfile);
    MemoLog.Lines.Add('Total Bytes: ' + IntToStr(TotalBytes));
    if ftp.StoreFile(remotefile,False) then
      MemoLog.Lines.Add('Transferencia completa')
    else
      MemoLog.lines.add('Transferencia fallida');
    Application.ProcessMessages;
    Sleep(1000);
  finally
    ftp.Logout;
    ftp.free;
  end;
  MemoLog.Lines.Add(#13#10+'Envío de archivos finalizado'+#13#10+'Puede cerrar (salir) esta ventana');
  btnEnviar.Enabled:=True;
  btnSalir.Enabled:=True;
end;

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

procedure TForm1.FormCreate(Sender: TObject);
begin
  edContrasena.EchoMode:=emPassword;
  edServidor.EchoMode:=emPassword;
  edUsuario.EchoMode:=emPassword;
end;

procedure TForm1.SockCallBack(Sender: TObject; Reason: THookSocketReason;
const Value: string);
begin
  Application.ProcessMessages;
  case Reason of
    HR_WriteCount:
    begin
      inc(CurrentBytes, StrToIntDef(Value, 0));
      ProgressBar1.Position := Round(100 * (CurrentBytes / TotalBytes));
    end;
  HR_Connect: CurrentBytes := 0;
end;
end;

end.


Descargar proyecto (incluye el archivo listado.txt): EnviaraFTP.7z



miércoles, 24 de enero de 2018

Medir el tiempo de ejecución de un proceso

Hacer el "benchmark" de una función, proceso o programa es algo relativamente simple en Lazarus/FreePascal utilizando la unidad dateutils.

En este ejemplo vamos a calcular cuanto se tarda en imprimir 10.000 líneas en un TMemo. También obtendremos la velocidad promedio de líneas por segundo.

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, DateTimePicker, Forms, Controls, Graphics,
  Dialogs, StdCtrls, dateutils;

type

{ TForm1 }

TForm1 = class(TForm)
  Button1: TButton;
  Button2: TButton;
  CheckBox1: TCheckBox;
  dtpEmpieza: TDateTimePicker;
  dtpFinaliza: TDateTimePicker;
  dtpTranscurrido: TDateTimePicker;
  edImpps: TEdit;
  Label1: TLabel;
  Label2: TLabel;
  Label3: TLabel;
  Label4: TLabel;
  Memo1: TMemo;
  procedure Button1Click(Sender: TObject);
  procedure Button2Click(Sender: TObject);
private
  procedure Empezar;
  procedure Finalizar;
{ private declarations }
public
{ public declarations }
end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  i:Integer;
begin
  Empezar;
  if CheckBox1.Checked then
  begin
    for i:=1 to 10000 do
    begin
      Application.ProcessMessages;
      Memo1.Lines.Add(IntToStr(i));
    end;
  end
  else
    begin
      for i:=1 to 10000 do
        Memo1.Lines.Add(IntToStr(i));
    end;
  Finalizar;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Memo1.Clear;
end;

procedure TForm1.Empezar;
begin
  dtpEmpieza.Time:=Now;
end;

procedure TForm1.Finalizar;
begin
  dtpFinaliza.Time:=Now;
  dtpTranscurrido.Time:=dtpFinaliza.Time-dtpEmpieza.Time;
  edImpps.Text:=FloatToStr((10000/((SecondOf(dtpTranscurrido.Time)+((MilliSecondOf(dtpTranscurrido.Time)/1000))))));
end;

end.

Desde ya se pueden quitar los dos TDateTimePicker y reemplazarlos por dos variables del tipo TTime, o ocultar dichos componentes. También reemplazar el valor 10000 por una constante o variable. Se puede jugar un buen rato.

Código fuente: MedirProcesos.7z o en GitLab


martes, 23 de enero de 2018

TListBox: conceptos básicos.

TListBox es un componente que muestra una lista de cadenas (strings) y resalta la seleccionada por el usuario. Se encuentra en la pestaña Standard de la paleta de componentes. Permite la multiselección pero en este ejemplo se usará la selección única.

Esta lista se compone de Items que son del tipo TString que es una clase abstracta.

Es como la implementación gráfica de un vector de cadenas, con propiedades y métodos que permiten su manipulación.

En el ejemplo se crea un programa que carga al comienzo la lista con algunos elementos y permite agregar, eliminar, borrar la lista, ordenarla, copiarla a un TMemo y recorrerla mostrando el recorrido en el Memo. También se muestra en un TEdit el elemento seleccionado.



unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

        { TForm1 }

    TForm1 = class(TForm)
                btnRecorrer: TBitBtn;
                btnListAMemo: TBitBtn;
                btnAgregar: TBitBtn;
                btnEliminar: TBitBtn;
                btnOrdenar: TBitBtn;
                btnBorrarTodo: TBitBtn;
                cbDuplicados: TCheckBox;
                edAgregar: TEdit;
                edSeleccionado: TEdit;
                lblSeleccionado: TLabel;
                ListBox1: TListBox;
                Memo1: TMemo;
                procedure btnRecorrerClick(Sender: TObject);
    procedure btnAgregarClick(Sender: TObject);
                procedure btnBorrarTodoClick(Sender: TObject);
                procedure btnEliminarClick(Sender: TObject);
                procedure btnListAMemoClick(Sender: TObject);
                procedure btnOrdenarClick(Sender: TObject);
                procedure FormCreate(Sender: TObject);
                procedure ListBox1Click(Sender: TObject);
    private
        function YaExiste (elemento: String): Boolean;
        { private declarations }
    public
        { public declarations }
    end;

var
    Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.btnAgregarClick(Sender: TObject);
begin
  if Length(Trim(edAgregar.Text))<1 then exit;
  //Trim elimina espacios en blanco, Length el tamaño.
  //Si ingresa un dato en blanco no hace nada.
  if not (cbDuplicados.Checked) then if YaExiste(edAgregar.Text) then exit;
  //Si no se marcó Permitir duplicados entonces se llama a la función YaExiste, si devuelve True no se agrega.
  ListBox1.AddItem(edAgregar.Text,ListBox1);
  //Además del string a agregar hay que especificar el objeto.
  edAgregar.Clear;
  //Limpia el TEdit. edAgregar.Text:='' también es válido.
end;

procedure TForm1.btnRecorrerClick(Sender: TObject);
var
  i:Integer;
begin
  Memo1.Clear;
  Memo1.Lines.Add('');
  Memo1.Lines.Add('for i:=0 to ListBox1.Count-1 do'+#13#10+'  Memo1.Lines.Add(ListBox1.Items.Strings[i]);'+#13#10);
  for i:=0 to ListBox1.Count-1 do
    //TListBox es base 0 (cero) por eso desde 0 hasta cantidad-1
    Memo1.Lines.Add('ListBox1.Items.Strings['+IntToStr(i)+']: '+ListBox1.Items.Strings[i]);
    //ListBox1.Items.String[i] así se accede al texto de cada ítem.
end;

procedure TForm1.btnBorrarTodoClick(Sender: TObject);
begin
  ListBox1.Clear;
  //Limpia la ListBox
end;

procedure TForm1.btnEliminarClick(Sender: TObject);
begin
  if ListBox1.ItemIndex>=0 then ListBox1.Items.Delete(ListBox1.ItemIndex);
  //Si hay algún ítem seleccionado, entonces ItemIndex tendrá un valor mayor o igual a cero, caso contrario será -1.
end;

procedure TForm1.btnListAMemoClick(Sender: TObject);
begin
  Memo1.Lines.Add('Memo1.Lines:=ListBox1.Items;');
  Memo1.Lines:=ListBox1.Items;
  //Ya la propiedades Lines e Items son del mismo tipo TStrings basta con asignar una a la otra.
end;

procedure TForm1.btnOrdenarClick(Sender: TObject);
begin
  ListBox1.Sorted:=True;
  ListBox1.Sorted:=False;
  //El False se agrega para que si se agrega un nuevo elemento lo agregue al final y se pueda volver a ordenar.
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListBox1.AddItem('Devuan',ListBox1);
  ListBox1.AddItem('Linux mint',ListBox1);
  ListBox1.AddItem('Gentoo',ListBox1);
  ListBox1.AddItem('Arch Linux',ListBox1);
  ListBox1.AddItem('Ubuntu',ListBox1);
  ListBox1.AddItem('Debian',ListBox1);
  ListBox1.AddItem('Mangaro',ListBox1);
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  edSeleccionado.Text:=ListBox1.Items.Strings[ListBox1.ItemIndex];
  //Se accede al texto Items.Strings y el índice lo tomamos de la propia lista ItemIndex que es el ítem seleccionado.
end;

function TForm1.YaExiste(elemento: String): Boolean;
//elemento es el texto de edAgregar
var
  i:Integer;
  ret:Boolean;
begin
  ret:=False;
  for i:=0 to listbox1.Count-1 do
    if elemento=listbox1.Items.Strings[i] then ret:=True;
  //Recorremos toda la lista buscando si ya existe.
  YaExiste:=ret;
end;

end. 


Como vemos, cuando ordenamos la lista, los elementos cambian el índice, no es solo un ordenamiento visual.

Para que la lista esté siempre ordenada basta con establecer la propiedad Sorted en True, de esta forma cuando se agregue un elemento, lo hará en la posición que le corresponda y no al final. Haciendo esto, el botón ordenar ya no tiene sentido y debe quitarse.

Código fuente: TListBox3.7z

Más entradas de ListBox.

domingo, 14 de enero de 2018

LazReport: incluir imagen de campo BLOB

Antes esto era una tarea un poco complicada según pude observar después de varias búsquedas que me mostraban hilos de foros de hace unos cuantos años. Por suerte esto ya no es así e incluir una imagen de cualquier formato (dentro de los más populares) almacenada en un campo o columna del tipo BLOB es tan sencillo que no requiere ni una línea de código.

Desde el diseñador LazReport debemos incluir un objeto del tipo imagen y nos aparecerá el siguiente diálogo:


La opción Cargar es para cargar una imagen contenida en un archivo, no es el caso. Debemos hacer click en Texto.


Y aquí tanto solo indicamos el campo que contiene la imagen. Si el dataset está conectado, podemos agregarlo desde el botón Campo de DB.
Eso es todo.


sábado, 13 de enero de 2018

Cambiar el ícono del programa y formularios

Esto que explicaré a continuación no cambia el icono del ejecutable, solo del programa en ejecución y los formularios (ventanas).

Para cambiar el icono principal, del programa, tenemos que ir a opciones del proyecto:


Es la primera opción así que encontrarla es bastante simple. Es importante respetar el tamaño y los bits por pulgada (bpp). No importa desde donde cargamos la imagen ya que pasará a ser parte del ejecutable. El formato debe ser .ico. Cualquier imagen se puede convertir a ICO usando GIMP se logra esto desde archivos--> Exportar como y escribir el nombrearchivo.ico y guardar.

Cuando se ejecute el programa en el panel se verá así:


Para cambiar o agregar un icono a un formulario (Form) desde el inspector de objetos ir a la propiedad icon y pulsar sobre los tres puntos (...):


para que se abra la siguiente ventana:


presionar "Cargar" el icono y aceptar.

viernes, 12 de enero de 2018

SQLite: Limpiar base de datos con VACUUM

El comando VACUUM copia todo el contenido de la base de datos a una base de datos temporal y luego sobre escribe la original, quedando de este modo, "limpia" u optimizada. Como cualquier comando SQLite lo podemos ejecutar ya sea desde consola, cómodamente utilizando la IDE SQLite Studio o desde código Free Pascal mediante una conexión Zeos con ExecuteDirect, por ejemplo:

ZConnection1.ExecuteDirect('VACUUM;');

Desde ya este comando necesita acceso exclusivo, no debe haber ninguna consulta activa ni transacción.

Desde la versión 3.15.0 (14 de octubre de 2016) se puede utilizar este comando en bases de datos adjuntas. Es importante saber que si se intentase ejecutar VACUUM a una base de datos adjunta desde una versión anterior, la adjunta (attached) será ignorada y VACUUM se ejecutará sobre la base de datos principal.

Tablas sin una clave primaria entera: VACUUM puede alterar los ROWIDs. Las tablas que tienen definida una INTEGER PRIMARY KEY no se modifican, solo aquellas que no lo posean. Es decir, si se utilizan los ROWIDs, algo poco recomendable, no se debe utilizar VACUUM ya que muy probablemente modifique sus valores.

Existe el pragma auto_vacuun que se puede habilitar, aunque según indican en el sitio oficial de SQLite "puede generar una fragmentación adicional de archivos de base de datos. Y auto_vacuum no compacta las páginas parcialmente rellenas de la base de datos como sí lo hace VACUUM.".

Este comando resulta extremadamente útil cuando se están realizando pruebas en la base de datos, generalmente en la etapa de diseño, una vez finalizas las mismas, usar VACUUM para una limpieza que además, reducirá el tamaño del archivo.

Como experiencia propia, estuve realizando pruebas con tipos de datos BLOB para almacenar imágenes, finalizada esta etapa, la base de datos estaba cerca de los 7 MB, luego de VACUUM su tamaño se redujo a 700 KB.

martes, 9 de enero de 2018

Formularios: establecer tamaños límites.

Si deseamos que un formulario pueda ser redimensionado por el usuario pero sobre un rango de valores mínimos y máximos, podemos valernos de las constraints (limitaciones) ya sea desde el inspector de objetos, previamente seleccionando el formulario, o por código.


Aquí vemos que MaxHeight y MaxWidth tiene valor cero, eso significa que puede agrandarse el formulario sin límites. En cambio en MinHeight y MinWidth le especificamos los valores mínimos del formulario, de esta forma si el usuario quiere achicarlo fuera de ese rango, le será imposible. Podrá achicarlo a por ejemplo 50x50 pero ni bien suelte el click del mouse, el formulario se redimensionará automáticamente a sus valores mínimos.
Lo mismo es válido para el tamaño máximo, solo hay que especificar los valores.

miércoles, 3 de enero de 2018

Libro para emprezar con Lazarus y Free Pascal en español

Es un libro libre distribuido bajo la licencia Creative Commons, del año 2012 y traducido al español. Son 150 páginas en formato PDF. Parte desde cero, motivo por el cual la mayor parte del libro son ejercicios o ejemplos por consola y recién los últimos capítulos con Lazarus. Como bien indicar el autor, el libro está dirigido a programadores y también a quienes no los son y quieren aprender a programar. Por mi parte también lo recomiendo para quienes dejaron de programar hace muchos años y en DOS, les ayudará mucho para dar ese salto a la programación con objetos, programación orientada a objetos y programación con interfaz gráfica. Y por si fuera poco, multiplataforma.

Y reitero que el año en que se hizo el libro no es un problema, ya que lo que se trata en el mismo, poco y nada a cambiado, es totalmente válido aún en 2018.

Dejo la versión original en inglés y la traducida al español.

Start programming using Object Pascal Free Pascal/Lazarus book

Introducción a la programación con Object Pascal Free Pascal / Lazarus

También puedes buscar más documentación en este sitio en:

Documentación y Enlaces.