Italian community of Lazarus and Free Pascal

function TForm1.Fattoriale(x:integer):longint;
begin
     if x=1 then
        Fattoriale:=1
     else
         Fattoriale:=x*Fattoriale(x-1);
end;

function TForm1.Permuta(Lista: string; a : integer; z : integer; elementi : integer ) : integer;
var	scambio	: char;
	k	: integer;
	i	: integer;
begin
    {Se il segmento di array contiene almeno due elementi, si procede.}
    if ( z-a ) >= 1 then
	begin
	    { Inizia il ciclo di scambi tra l'ultimo elemento e
	     uno degli altri contenuti nel segmento di array.}
	    k := z;
	    while k >= a do begin

		{Scambia i valori.}
		scambio := lista[k];
		lista[k] := lista[z];
		lista[z] := scambio;

		{ Esegue una chiamata ricorsiva per permutare un segmento più piccolo dell'array. }
		permuta(Lista, a, z-1, elementi);

		{ Scambia i valori.}
		scambio := lista[k];
		lista[k] := lista[z];
		lista[z] := scambio;

		k := k-1;

	    end;
	end
    else
	begin

	    {Visualizza la situazione attuale dell'array.}

	    for i := 1 to elementi do begin
                Grid_Risultato.Cells[Colonna, Riga]:=lista[i];
                Inc(Colonna);
	    end;
            Colonna:=0;
            Inc(Riga);
            MyProgressBar.Position:=MyProgressBar.Position+1;
	end;
end;

unit Unit1; 

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

  TForm1 = class(TForm)
    SaveDialog1: TSaveDialog;
    Txt_Esporta: TButton;
    Label1: TLabel;
    Lbl_Num: TLabel;
    MyProgressBar: TProgressBar;
    Grid_Risultato: TStringGrid;
    Txt_Elabora: TButton;
    Txt_StringaIn: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Txt_ElaboraClick(Sender: TObject);
    function Fattoriale(x:integer):longint;
    function Permuta(Lista: string; a : integer; z : integer; elementi : integer ) : integer;
    procedure Txt_EsportaClick(Sender: TObject);
  private
    { private declarations }
    Riga: integer;
    Colonna: integer;
  public
    { public declarations }
  end; 

var
  Form1: TForm1; 

implementation

{$R *.lfm}

{ TForm1 }

function TForm1.Fattoriale(x:integer):longint;
begin
     if x=1 then
        Fattoriale:=1
     else
         Fattoriale:=x*Fattoriale(x-1);
end;

procedure TForm1.Txt_ElaboraClick(Sender: TObject);
begin
     if Length(Txt_StringaIn.Text)>1 then
     begin
          Grid_Risultato.Clear;
          Riga:=0;
          Colonna:=0;
          Lbl_Num.Caption:=IntToStr(Fattoriale(Length(Txt_StringaIn.Text)));
          Form1.Repaint;
          MyProgressBar.Min:=1;
          MyProgressBar.Max:=Fattoriale(Length(Txt_StringaIn.Text));
          Grid_Risultato.ColCount:=Length(Txt_StringaIn.Text);
          Grid_Risultato.RowCount:=Fattoriale(Length(Txt_StringaIn.Text));;
          Permuta(Txt_StringaIn.Text,1,Length(Txt_StringaIn.Text),Length(Txt_StringaIn.Text));
          ShowMessage('ELABORAZIONE TERMINATA');
     end
     else
     begin
          ShowMessage('Devi inserire una parola maggiore di 1 carattere!');
     end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     Grid_Risultato.Clear;
     Lbl_Num.Caption:='0';
end;

function TForm1.Permuta(Lista: string; a : integer; z : integer; elementi : integer ) : integer;
var	scambio	: char;
	k	: integer;
	i	: integer;
begin
    {Se il segmento di array contiene almeno due elementi, si procede.}
    if ( z-a ) >= 1 then
	begin
	    { Inizia il ciclo di scambi tra l'ultimo elemento e
	     uno degli altri contenuti nel segmento di array.}
	    k := z;
	    while k >= a do begin

		{Scambia i valori.}
		scambio := lista[k];
		lista[k] := lista[z];
		lista[z] := scambio;

		{ Esegue una chiamata ricorsiva per permutare un segmento più piccolo dell'array. }
		permuta(Lista, a, z-1, elementi);

		{ Scambia i valori.}
		scambio := lista[k];
		lista[k] := lista[z];
		lista[z] := scambio;

		k := k-1;

	    end;
	end
    else
	begin

	    {Visualizza la situazione attuale dell'array.}

	    for i := 1 to elementi do begin
                Grid_Risultato.Cells[Colonna, Riga]:=lista[i];
                Inc(Colonna);
	    end;
            Colonna:=0;
            Inc(Riga);
            MyProgressBar.Position:=MyProgressBar.Position+1;
	end
    ;
end;

procedure TForm1.Txt_EsportaClick(Sender: TObject);
var
   app:TStringList;
   nome: string;
   parola: string;
   i, j: integer;
begin
    if SaveDialog1.Execute then
       nome:=SaveDialog1.Filename;
    if length(trim(nome))>0 then
    begin
         app:=TStringList.Create;
         for i:=0 to Grid_Risultato.RowCount-1 do
         begin
             parola:='';
             for j:=0 to Grid_Risultato.ColCount-1 do
             begin
                  parola:=parola + Grid_Risultato.Cells[j,i];
             end;
             app.Add(parola);
         end;
         app.SaveToFile(nome);
         app.Free;
         ShowMessage('Esportazione avvenuta con successo: ' + nome);
    end
    else
    begin
         ShowMessage('Devi stabilire dove salvare il file');
    end;
end;

end.