procedure TForm1.Button1Click(Sender: TObject);
var
devList, disklist:TStringList;
RegexObj: TRegExpr;
diskid, symlnk, RegexpInput:String;
i:integer;
begin
RegexpInput:='';
if ListBox1.SelCount=0 then exit;
diskid:=ListBox1.Items.Strings[ListBox1.ItemIndex];
devList := TStringList.Create;
devList.Sorted:=True;
devList.Duplicates:=dupIgnore;
disklist:=TStringList.Create;
disklist.Sorted:=True;
disklist.Duplicates:=dupIgnore;
devList:=FindAllFiles('/dev/disk/by-id');
for i:=0 to devList.Count-1 do
begin
symlnk:=ReadAllLinks(devList[i],False);
disklist.Add(symlnk);
if (symlnk=diskid) then RegexpInput:=RegexpInput+devList[i]+LineEnding;
end;
RegexObj:=TRegExpr.Create;
RegexObj.Expression:='ata.*_([^ ]*)\n';
if RegexObj.Exec(RegexpInput) then
lblSerial.Caption:=RegexObj.Match[1];
devList.Free;
disklist.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
devList, disklist:TStringList;
RegexObj: TRegExpr;
diskid, symlnk, RegexpInput:String;
i:integer;
maximo:Integer;
begin
lblSerial.Caption:='';
devList := TStringList.Create;
devList.Sorted:=True;
devList.Duplicates:=dupIgnore;
disklist:=TStringList.Create;
disklist.Sorted:=True;
disklist.Duplicates:=dupIgnore;
devList:=FindAllFiles('/dev/disk/by-id');
for i:=0 to devList.Count-1 do
begin
symlnk:=ReadAllLinks(devList[i],False);
disklist.Add(symlnk);
if (symlnk=diskid) then RegexpInput:=RegexpInput+devList[i]+LineEnding;
end;
disklist.sort;
ListBox1.Items:=disklist;
maximo:=Length(ListBox1.Items.Strings[0]);
for i:=ListBox1.Items.Count-1 downto 0 do
begin
if Length(ListBox1.Items.Strings[i])>maximo then
ListBox1.Items.Delete(i);
end;
devList.Free;
disklist.Free;
end;
Cada vez que creamos una unidad en Lazarus, vemos esto:
unit Unit1;
{$mode objfpc}{$H+}
Son interruptores (switch) que indican al compilador como debe compilar. En el caso de {$H+} se le está indicando que cuando se defina un string deberá el compilador asumir que es un AnsiString, es decir, que el string no tendrá una limitación en cuanto al tamaño, a no ser que se especifique un tamaño, en tal caso, será tratado como un ShortSting cuyo tamaño máximo es de 255 caracteres. Si necesitamos que en una unidad de nuestro proyecto todo lo que definamos como string sea tratado como ShortString, podemos utilizar el switch $H- de la siguiente forma:
unit Unit1;
{$mode objfpc}{$H-}
Lo habitual (y por eso viene así por default) es {$H+}.
{$mode objfpc} le indica al compilador el modo de compilación Object Free Pascal Compiler, lo que implica por ejemplo que se pueden utilizar comentarios anidados, se permite la sobrecarga (overloading) de funciones, los PChar son convertidos en Strings automáticamente y otras cosas más que pueden leerse aquí en inglés.
Visualmente le hemos agregado 4 botones para seleccionar todos los ítems o elementos y otro para des-seleccionar. También hemos activado el drag and drop del ListBox1 hacia el ListBox2.
Cómo hacer el drag and drop entre dos ListBox?
Desde el inspector de objetos, seleccionamos ListBox1y vamos a la pestaña de eventos, allí debemos seleccionar dmAutomatic en DragMode.
Ahora pasamos al ListBox2 y debemos definir los eventos OnDragOver y OnDragDrop.
Para ello debemos hacer click sobre los ... tanto en OnDragDrop como en OnDragOver para que Lazarus nos escriba el código de los eventos.
En el evento OnDragOver tenemos que decir que pasa cuando "sobre vuela" sobre el ListBox2 un elemento arrastrado con el mouse.
procedure TForm1.ListBox2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept:=(Source is TListBox);
end;
Con esta línea de código indicamos que se acepte si viene de otro TListBox.
Es con el evento OnDragDrop donde especificamos que hacer con el elemento recibido, en este caso es agregar dicho elemento a la lista, pero podríamos definir cualquier otra acción.
procedure TForm1.ListBox2DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
btnAgregarClick(Self);
end;
Como ya tenemos un procedimiento para agregar, que es el evento OnClick del botón Agregar, por qué no utilizarlo y evitar escribir el código dos veces.
Eso es todo respecto de arrastrar y soltar.
Seleccionar todo y desmarcar todo: como ya está definido, resulta algo muy sencillo, no obstante, hay que saber de su existencia para no reinventar la rueda.
procedure TForm1.btnTodoL1Click(Sender: TObject);
begin
ListBox1.SelectAll;
end;
procedure TForm1.btnTodoL2Click(Sender: TObject);
begin
ListBox2.SelectAll;
end;
No hace falta explicar nada, SelectAll lo dice todo.
Para hacer lo contrario, des-seleccionar todo:
procedure TForm1.btnQuitarL1Click(Sender: TObject);
begin
ListBox1.ClearSelection;
end;
procedure TForm1.btnQuitarL2Click(Sender: TObject);
begin
ListBox2.ClearSelection;
end;
procedure TForm1.btnAgregarClick(Sender: TObject);
var
i:Integer;
begin
if ListBox1.Count<1 then exit; //Si no hay elementos no hace nada
for i:=0 to ListBox1.Count-1 do //Recorre todo el ListBox1
if ListBox1.Selected[i] then //Si el ítem está seleccionado
if not (YaExiste(ListBox1.Items.Strings[i])) then //Si el ítem a agregar ya existe no lo agrega
ListBox2.AddItem(ListBox1.Items.Strings[i],ListBox2); //Agrega el ítem
ListBox1.ClearSelection;
end;
procedure TForm1.btnAgregarTodosClick(Sender: TObject);
begin
ListBox2.Items:=ListBox1.Items;
ListBox1.ClearSelection;
end;
procedure TForm1.btnQuitarClick(Sender: TObject);
var
i:Integer;
begin
if ListBox2.SelCount > 0 then //Si hay ítems seleccionados
for i:=ListBox2.Items.Count-1 downto 0 do //Recorre todo el ListBox2
if ListBox2.Selected[i] then //Si el ítem está seleccionado
ListBox2.Items.Delete(i); //Borra el ítem
end;
procedure TForm1.btnQuitarL1Click(Sender: TObject);
begin
ListBox1.ClearSelection;
end;
procedure TForm1.btnQuitarL2Click(Sender: TObject);
begin
ListBox2.ClearSelection;
end;
procedure TForm1.btnQuitarTodosClick(Sender: TObject);
begin
ListBox2.Clear;
end;
procedure TForm1.btnTodoL1Click(Sender: TObject);
begin
ListBox1.SelectAll;
end;
procedure TForm1.btnTodoL2Click(Sender: TObject);
begin
ListBox2.SelectAll;
end;
procedure TForm1.ListBox2DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
btnAgregarClick(Self);
end;
procedure TForm1.ListBox2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept:=(Source is TListBox);
end;
function TForm1.YaExiste(elemento: String): Boolean;
var
i:Integer;
ret:Boolean;
begin
ret:=False;
for i:=0 to ListBox2.Count-1 do
if elemento=ListBox2.Items.Strings[i] then ret:=True;
YaExiste:=ret;
end;
Al ListBox1 le hemos agregado los ítems desde el inspector de objetos; el ListBox2 lo hemos creado vacío. Ambos elementos fueron agregados al Form desde la paleta Standard. Los botones son del tipo TBitBtn, disponibles desde la paleta Additional, pero puede usarse en su lugar un TButton simple, claro que no se le podrá anexar una imagen, pero para este ejemplo es lo mismo.
También desde e inspector de objetos hemos marcado (True) la opción MultiSelect de ambos ListBox.
El código: unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons; type { TForm1 } TForm1 = class(TForm) btnAgregar: TBitBtn; btnAgregarTodos: TBitBtn; btnQuitar: TBitBtn; btnQuitarTodos: TBitBtn; ListBox1: TListBox; ListBox2: TListBox; StaticText1: TStaticText; StaticText2: TStaticText; procedure btnAgregarClick(Sender: TObject); procedure btnAgregarTodosClick(Sender: TObject); procedure btnQuitarClick(Sender: TObject); procedure btnQuitarTodosClick(Sender: TObject); private { private declarations } public function YaExiste (elemento:String):Boolean; { public declarations } end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.btnAgregarClick(Sender: TObject); var i:Integer; begin if ListBox1.Count<1 then exit; //Si no hay elementos no hace nada for i:=0 to ListBox1.Count-1 do //Recorre todo el ListBox1 if ListBox1.Selected[i] then //Si el ítem está seleccionado if not (YaExiste(ListBox1.Items.Strings[i])) then //Si el ítem a agregar ya existe no lo agrega ListBox2.AddItem(ListBox1.Items.Strings[i],ListBox2); //Agrega el ítem end; procedure TForm1.btnAgregarTodosClick(Sender: TObject); begin ListBox2.Items:=ListBox1.Items; end; procedure TForm1.btnQuitarClick(Sender: TObject); var i:Integer; begin if ListBox2.SelCount > 0 then //Si hay ítems seleccionados for i:=ListBox2.Items.Count-1 downto 0 do //Recorre todo el ListBox2 if ListBox2.Selected[i] then //Si el ítem está seleccionado ListBox2.Items.Delete(i); //Borra el ítem end; procedure TForm1.btnQuitarTodosClick(Sender: TObject); begin ListBox2.Clear; end; function TForm1.YaExiste(elemento: String): Boolean; var i:Integer; ret:Boolean; begin ret:=False; for i:=0 to ListBox2.Count-1 do if elemento=ListBox2.Items.Strings[i] then ret:=True; YaExiste:=ret; end; end.
Si se intenta agregar un elemento que ya existe, lo ignora. Pasar todos los elementos de una lista a otra es cuestión de una sola linea:
ListBox2.Items:=ListBox1.Items;
Quitar todos los elementos de una lista, basta con:
Si queremos que los elementos de las listas se muestren siempre ordenados, desde el inspector de objetos, en ambas listas marcamos la propiedad Sorted (True).
