Italian community of Lazarus and Free Pascal

unit Unit1; 

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Cmd_Aggiungi: TButton;
    PageControl1: TPageControl;
    Box_DisposizionePosti: TTabSheet;
    procedure Button1Click(Sender: TObject);
    procedure Cmd_AggiungiClick(Sender: TObject);
    procedure EffettuaOperazione(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
    Riga, y: integer;
    x, j: integer;
  public
    { public declarations }
  end; 

var
  Form1: TForm1; 

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.EffettuaOperazione(Sender: TObject);
var
   i: integer;
   Nome: string;
begin
     i:=0;
     //cicla fino a quando non ho passato in rassegna tutti i conrolli del box
     //cioè i pulsanti creati tramite codice
     while (Box_DisposizionePosti.ControlCount>i) do
           begin
                if 
Box_DisposizionePosti.Controls[i].Name=ActiveControl.Name then //se il 
controllo è quello attivo, cioè se sono sul controllo che rappresenta il
 pulsante schiacciato
                   begin
                        if ((Box_DisposizionePosti.Controls.Color)=clGreen) then
                        begin
                           //Nome del pulsante su cui ho schiacciato
                           Nome:=Box_DisposizionePosti.Controls.Name;
                           ShowMessage(Nome);
                        end;
                   end;
                Inc(i);
           end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     Riga:=0;
     y:=0;
     j:=0;
end;

procedure TForm1.Cmd_AggiungiClick(Sender: TObject);
var
     i: integer;
begin
       with TEdit.Create(Self) do begin
            Height:=25;
            Width:=40;
            if Box_DisposizionePosti.ChildSizing.Layout=cclNone then begin
               y:=y+Height+2;
               x:=j*Width;
               SetBounds(x,y,Width,Height);
               Inc(j);
            end;
            Name:='Cmd_Controllo_'+IntToStr(Riga);
            Inc(Riga);
            Parent:=Box_DisposizionePosti;
            Enabled:=TRUE;
            //rendo la editbox di sola lettura
            ReadOnly:=TRUE;
            Color:=clGreen; //di colore verde
            //allineo il testo al centro della edit
            Alignment:=taCenter;
            Text:='Tasto' + IntToStr(Riga);
            //cambio il tipo di puntatore del mouse
            Cursor:=crHandPoint;
            OnClick:=@EffettuaOperazione;
       end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
     i: integer;
begin
     i:=Box_DisposizionePosti.ControlCount-1;
     // cancello postazioni che non servono più
     while i>=0 do
     begin
           Box_DisposizionePosti.Controls.Free;
           Dec(i);
     end;
     Riga:=0;
end;

end.
A volte si presenta la necessità di generare dei controlli sulle 
maschera in quantità variabile. In tal caso ci vengono in aiuto i 
controlli a Run-Time. Ovvero li creo tramite codice. Ora allego un 
semplice esempio, che basta compilare e provare ad eseguire per capire 
di cosa parlo.


unit Unit1; 

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Cmd_Aggiungi: TButton;
    PageControl1: TPageControl;
    Box_DisposizionePosti: TTabSheet;
    procedure Button1Click(Sender: TObject);
    procedure Cmd_AggiungiClick(Sender: TObject);
    procedure EffettuaOperazione(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
    Riga, y: integer;
    x, j: integer;
  public
    { public declarations }
  end; 

var
  Form1: TForm1; 

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.EffettuaOperazione(Sender: TObject);
var
   i: integer;
   Nome: string;
begin
     i:=0;
     //cicla fino a quando non ho passato in rassegna tutti i conrolli del box
     //cioè i pulsanti creati tramite codice
     while (Box_DisposizionePosti.ControlCount>i) do
           begin
                if 
Box_DisposizionePosti.Controls[i].Name=ActiveControl.Name then //se il 
controllo è quello attivo, cioè se sono sul controllo che rappresenta il
 pulsante schiacciato
                   begin
                        if ((Box_DisposizionePosti.Controls.Color)=clGreen) then
                        begin
                           //Nome del pulsante su cui ho schiacciato
                           Nome:=Box_DisposizionePosti.Controls.Name;
                           ShowMessage(Nome);
                        end;
                   end;
                Inc(i);
           end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     Riga:=0;
     y:=0;
     j:=0;
end;

procedure TForm1.Cmd_AggiungiClick(Sender: TObject);
var
     i: integer;
begin
       with TEdit.Create(Self) do begin
            Height:=25;
            Width:=40;
            if Box_DisposizionePosti.ChildSizing.Layout=cclNone then begin
               y:=y+Height+2;
               x:=j*Width;
               SetBounds(x,y,Width,Height);
               Inc(j);
            end;
            Name:='Cmd_Controllo_'+IntToStr(Riga);
            Inc(Riga);
            Parent:=Box_DisposizionePosti;
            Enabled:=TRUE;
            //rendo la editbox di sola lettura
            ReadOnly:=TRUE;
            Color:=clGreen; //di colore verde
            //allineo il testo al centro della edit
            Alignment:=taCenter;
            Text:='Tasto' + IntToStr(Riga);
            //cambio il tipo di puntatore del mouse
            Cursor:=crHandPoint;
            OnClick:=@EffettuaOperazione;
       end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
     i: integer;
begin
     i:=Box_DisposizionePosti.ControlCount-1;
     // cancello postazioni che non servono più
     while i>=0 do
     begin
           Box_DisposizionePosti.Controls.Free;
           Dec(i);
     end;
     Riga:=0;
end;

end.