domingo, 25 de agosto de 2019

Evitar varias instancias de un programa.

La mayoría de la veces para que un programa funcione bien, es imprescindible que solo se ejecute una vez al mismo tiempo, es decir, permitir una única instancia de ejecución del programa.

El paquete UniqueInstance, nos permite agregar esta funcionalidad a nuestros programas, de manera sencilla.

Este paquete se puede instalar cómodamente desde OPM (On Line Package Manager) disponible en versiones de Lazarus 1.8.4 y posteriores.


Una vez instalado y reconstruida la IDE, el componente se encuentra en la paleta System, el círculo rojo con el número 1.


Se coloca en el formulario principal del programa.


En el inspector de objetos se lo activa y se le establece un identificador que, como se ve en la imagen, puede ser cualquier cadena de caracteres.


En eventos, solo hay uno, lo creamos presionando sobre los tres puntos.

procedure TForm1.UniqueInstance1OtherInstance(Sender: TObject;
ParamCount: Integer; const Parameters: array of String);
begin
  ShowMessage('El programa ya se está ejecutando.');
  BringToFront;
  FormStyle:=fsSystemStayOnTop;
  FormStyle:=fsNormal;
end;


Ahí podemos hacer algo simple, como un showmessage y luego traer al frente el programa, dado que el usuario seguramente lo tenga minimizado y no lo vea.

Simple programa de ejemplo:

unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

{ TForm1 }

TForm1 = class(TForm)
  Button1: TButton;
  UniqueInstance1: TUniqueInstance;
  procedure Button1Click(Sender: TObject);
  procedure UniqueInstance1OtherInstance(Sender: TObject;
  ParamCount: Integer; const Parameters: array of String);
private

public

end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

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

procedure TForm1.UniqueInstance1OtherInstance(Sender: TObject;
ParamCount: Integer; const Parameters: array of String);
begin
  ShowMessage('El programa ya se está ejecutando.');
  BringToFront;
  FormStyle:=fsSystemStayOnTop;
  FormStyle:=fsNormal;
end;

end.

jueves, 15 de agosto de 2019

Cambiar imágenes en TListView y TImageList.

Lo que parecía simple, lo era, el tema fue probar varias veces mil formas hasta no conseguirlo y preguntar en el foro, donde un "agradable sujeto" me guió con este código:

ListView1.SmallImages:=nil;
ListView1.SmallImages:=ImageList1;


El problema no eran mensajes de error de ningún tipo, sino que no actualizaba la imagen que quería cambiar ya sea mediante un TImage o TImageList y simplemente, no pasaba nada.


En la primera lista, utilizando el IDE, cargo 4 ítems; la lista 2 está vacía lo mismo la lista de imágenes 2 y la imagen que se ve arriba del primer botón. La imagen corresponde al programa en ejecución luego de haber presionado los dos botones.

Con Button1, si hay un elemento de la lista1 seleccionado, se permite cambiarlo por una imagen almacenada en el disco que tenga como máximo 32x32 píxeles.

Con Button2, cargo 10 imágenes ubicadas en la misma carpeta que el programa en ImageList2 y luego se asignan a ListView1.

El problema del espacio que hay entre las imágenes, especialmente notorio en ListView1 es un problema de GTK que reserva espacio para el texto (caption) y si no se utiliza, pues lo deja igual, con otros widgets las imágenes prácticamente se tocan.

Código:

unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    ImageList1: TImageList;
    ImageList2: TImageList;
    ListView1: TListView;
    ListView2: TListView;
    OpenPictureDialog1: TOpenPictureDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  if ListView1.ItemIndex<0 then Exit;
  if OpenPictureDialog1.Execute then
    begin
      try
        Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
      Except
         begin
           ShowMessage('Invalid image.');
           Exit;
         end;
      end;
      if (Image1.Picture.Height>32) or (Image1.Picture.Width>32) then
      begin
        ShowMessage('The image > 32x32 pix.');
        Image1.Picture.Clear;
        Exit;
      end;
    end
    else Exit;
  ImageList1.Delete(ListView1.ItemIndex);
  ImageList1.Insert(ListView1.ItemIndex,Image1.Picture.Bitmap,nil);
  ListView1.SmallImages:=nil;
  ListView1.SmallImages:=ImageList1;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  i:Word;
  imagen:TImage;
  li:TListItem;
begin
  imagen:=TImage.Create(nil);
  for i:=0 to 9 do
    begin
      imagen.Picture.LoadFromFile(Application.Location+'00'+IntToStr(i)+'.png');
      ImageList2.Insert(i,imagen.Picture.Bitmap,nil);
      li:=ListView2.Items.Add;
      li.Caption:=IntToStr(i);
      li.ImageIndex:=i;
      imagen.Picture.Clear;
    end;
  FreeAndNil(imagen);
  ListView2.SmallImages:=nil;
  ListView2.SmallImages:=ImageList2;
end;

end.

Algunos comentarios acercar del código:
Respecto de la primera lista ListView1:

  if ListView1.ItemIndex<0 then Exit;
  if OpenPictureDialog1.Execute then
    begin
      try
        Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
      Except
         begin
           ShowMessage('Invalid image.');
           Exit;
         end;
      end;
      if (Image1.Picture.Height>32) or (Image1.Picture.Width>32) then
      begin
        ShowMessage('The image > 32x32 pix.');
        Image1.Picture.Clear;
        Exit;
      end;
    end
    else Exit;

Lo primero a validar es que se haya seleccionado un ítem de la lista, sino, chau.
Éste es un claro ejemplo de cuándo utilizar try/Except justificadamente y no sólo por el hecho de que existe, porque el usuario, todo lo puede, por ejemplo intentar abrir un archivo que no es una imagen, entonces si la imagen está OK, continuamos, caso contrario, mensaje y salimos sin romper nada.
La siguiente validación es que la imagen no exceda los 32x32 pix. que es el tamaño definido mediante el inspector de objetos para las imágenes de ListView1. Si se supera el filtro, entonces:

  ImageList1.Delete(ListView1.ItemIndex);
  ImageList1.Insert(ListView1.ItemIndex,Image1.Picture.Bitmap,nil);
  ListView1.SmallImages:=nil;
  ListView1.SmallImages:=ImageList1;

Encontré fácil 10 métodos distintos para esto, finalmente usando los métodos Delete e Insert funciona y es simple. Primero se borra el ítem según ItemIndex y luego se agrega en la posición ItemIndex la imagen de Image1.
Finalmente, la clave, se establece en nil SmallImages y luego se le asigna ImageList1.

En cuanto a la otra lista, ListView2:

procedure TForm1.Button2Click(Sender: TObject);
var
  i:Word;
  imagen:TImage;
  li:TListItem;
begin
  imagen:=TImage.Create(nil);

La variable li del tipo TListItem es necesaria para agregar elementos (ítems) a la lista vacía y no se crea, porque se crea en TListItemS, así está explicado en el código fuente por los programadores de Lazarus.

Descargar código fuente: TListView_TImageList.7z