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.