Italian community of Lazarus and Free Pascal

Portal features

Pagine: 1 ... 10 11 [12] 13 14

16 Nov 2011 - Lazarus e la crittografia

Written by xinyiman Novembre 16, 2011, 08:58:00 am 15770 Views Rating: 0 (0 Rates) Print

Chi necessita di lavorare con la crittografia troverà in Lazarus un valido alleato perchè esiste un componente chiamato DCPCrypt (http://wiki.lazarus.freepascal.org/DCPcrypt) che permette di lavorare con i più diffusi algoritmi di crittografia.
Vediamo ora un esempio per capire come si usa.

Codice: [Seleziona]


unit Unit1; 

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  DCPdes, DCPrc4, DCPsha1;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    DCP_rc4_1: TDCP_rc4;
    DCP_sha1_1: TDCP_sha1;
    Label1: TLabel;
    Label2: TLabel;
    Lbl_Algoritmo: TLabel;
    Txt_In: TEdit;
    Txt_Out: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end; 

var
  Form1: TForm1; 

implementation

{$R *.lfm}

{ TForm1 }

{procedura che cifra una stringa}
procedure TForm1.Button1Click(Sender: TObject);
var
    i: integer;
    Cipher: TDCP_rc4;
    KeyStr: string;
begin
    KeyStr:= '';
    if InputQuery('Passphrase','Inserisci la passphrase',KeyStr) then  // richiedo la passphrase per cifrare la stringa
    begin
      Cipher:= TDCP_rc4.Create(Self); 
      Cipher.InitStr(KeyStr,TDCP_sha1);         // inizializzare il cifrario con un hash della password
      Txt_Out.Text := Cipher.EncryptString(Txt_In.Text); //cifro il testo contenuto nella TEdit di nome Txt_In e metto il risultato nella TEdit Txt_Out
      Lbl_Algoritmo.Caption:= Cipher.GetAlgorithm; //visualizzo quale algoritmo ho usato in una TLabel di nome Lbl_Algoritmo
      Cipher.Burn;
      Cipher.Free;
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
    i: integer;
    Cipher: TDCP_rc4;
    KeyStr: string;
begin
    KeyStr:= '';
    if InputQuery('Passphrase','Inserisci la passphrase',KeyStr) then  // richiedo la passphrase per cifrare la stringa
    begin
      Cipher:= TDCP_rc4.Create(Self);
      Cipher.InitStr(KeyStr,TDCP_sha1);         // inizializzare il cifrario con un hash della password
      Txt_Out.Text := Cipher.DecryptString(Txt_In.Text); //decifro il testo contenuto nella TEdit di nome Txt_In e metto il risultato nella TEdit Txt_Out
      Lbl_Algoritmo.Caption:= Cipher.GetAlgorithm; //visualizzo quale algoritmo ho usato in una label di nome Lbl_Algoritmo
      Cipher.Burn;
      Cipher.Free;
    end;
end;

end.

Potete trovare l'esempio appena visto all'indirizzo: www.lazaruspascal.it/esempi/Cifratore.zip

14 Nov 2011 - Ampliare Lazarus

Written by xinyiman Novembre 14, 2011, 02:36:00 pm 17300 Views Rating: 0 (0 Rates) Print

A volte si necessita di estendere le funzionalità di Lazarus, perchè gli strumenti necessari non sono completi. Facciamo l'esempio di una installazione pulita di Lazarus, in tale installazione non è (di norma) presente il LazReport anche se il pacchetto per installarlo lo avete già tra le cose a vostra disposizione.

Quindi per prima cosa vediamo dove trovare i pacchetti di cui già disponiamo e che vogliamo installare, di norma su windows li troviamo in c:\lazarus\components\ mentre di norma su linux (ubuntu) troviamo tali paccehtti in \usr\lib\lazarus\components

Bene per proseguire con l'esempio che stavamo vedendo apriamo
Lazarus -> Package -> Apri il file del pacchetto (*.lpk)
Compare una schermata che chiede dove andare a prendere il file necessario e noi gli diciamo C:\lazarus\components\lazreport\source\lazreport.lpk
Diamo compila e poi installa, ci chiederà se vogliamo chiudere e riaprire lazarus, voi dite di si e aspettate che abbia finito.

Bene ora vedrete tra le linguette di Lazarus una nuova chiamata lazreport. Questo procedimento è di norma la prassi per installare un nuovo componente su Lazarus, come abbiamo visto una serie di questi componenti li abbiamo già sul nostro pc, altri li dobbiamo scaricare da internet. Qui trovate un resoconto di ciò che potete installare:

http://wiki.lazarus.freepascal.org/Components_and_Code_examples

10 Nov 2011 - Generare controlli RUN-TIME

Written by xinyiman Novembre 10, 2011, 10:48:00 pm 15881 Views Rating: 0 (0 Rates) Print

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.

Codice: [Seleziona]


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.

L'esempio appena visto è possibile scaricarlo nella sua interezza qui: www.lazaruspascal.it/esempi/Controlli_RunTime.zip

07 Nov 2011 - TTreeview e Menu

Written by xinyiman Novembre 07, 2011, 12:11:00 pm 15850 Views Rating: 0 (0 Rates) Print

Non vi è mai capitato di dover usare dei menù nei vostri programmi? Se la risposta è si allora sappiate che è possibile tabellare i menù (con le dovute premure) e visualizzare tali menù in una TTreeview in maniere tale da rendere il programma pulito ed efficente.

Per prima cosa vediamo il codice d'esempio che potete trovare in versione integrale all'indirizzo: www.lazaruspascal.it/esempi/MenuTabellato.zip

unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

{ TForm1 }

TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    PageControl1: TPageControl;
    PairSplitter1: TPairSplitter;
    PairSplitterSide1: TPairSplitterSide;
    PairSplitterSide2: TPairSplitterSide;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TreeView1: TTreeView;
    MyConn: TZConnection;
    MyQuery: TZQuery;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
private
    { private declarations }
    function InserisciNodiFigli(NodoPadre: integer): boolean;
public
    { public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var
   i: integer;
begin
     MyConn.Protocol:='sqlite-3';
     MyConn.HostName:='localhost';
     MyConn.Database:= Application.Location + 'menu.s3db';
     MyConn.Connect;

     i:=0;
     InserisciNodiFigli(i);
     TreeView1.ShowRoot:=true;
end;

function TForm1.InserisciNodiFigli(NodoPadre: integer): boolean;
var
   MyQuery2: TZQuery;
   app: TTreeNode;
begin
     if NodoPadre>1 then
        app:=TreeView1.Items.GetLastSubNode;
     MyQuery2:=TZQuery.Create(nil);
     MyQuery2.Connection:=MyConn;
     MyQuery2.SQL.Text:='select * FROM T_Menu WHERE NodoPadre=' + IntToStr(NodoPadre) + ' order by Posizione ASC;';
     MyQuery2.Open;
     if not MyQuery2.EOF then
     begin
          MyQuery2.First;
          while not MyQuery2.EOF do
          begin
               if NodoPadre=0 then
               begin
                    TreeView1.Items.Add(nil, MyQuery2.FieldByName('Descrizione').Text);
               end
               else if NodoPadre=1 then
               begin
                    TreeView1.Items.AddChild(TreeView1.Items.GetLastNode, MyQuery2.FieldByName('Descrizione').Text);
               end
               else
               begin
                    TreeView1.Items.AddChild(app , MyQuery2.FieldByName('Descrizione').Text);
               end;

               InserisciNodiFigli(MyQuery2.FieldByName('Posizione').AsInteger);
               MyQuery2.Next;
          end;
     end;
     MyQuery2.Close;
     MyQuery2.Free;
     InserisciNodiFigli:=true;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
     MyConn.Disconnect;
end;

procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
begin
     MyQuery.SQL.Text:='select NumTab FROM T_Menu WHERE Descrizione="' + StringReplace(TreeView1.Selected.Text,'''','''''', [rfReplaceAll]) + '";';
     MyQuery.Open;
     if not MyQuery.EOF then
     begin
          MyQuery.First;
          PageControl1.TabIndex:=MyQuery.FieldByName('NumTab').AsInteger;
     end;
     MyQuery.Close;
end;

end.

Come potete notare la funzione ricorsiva InserisciNodiFigli crea il menù popolato con i dati tabellati, e nell'esempio che abbiamo appena visto i dati sono così espressi

Descrizione	NodoPadre	Posizione	NumTab
Clienti	0	1	0
Inserisci	1	2	0
Modifica	1	3	0
Ins1	3	4	1
Ins2	3	5	1
Elimina	1	6	2
Magazzino	0	7	0

Quello che bisogna capire è che il NodoPadre deve essere zero per tutte le righe che devono comparire come voci primarie del menù, mentre il campo Posizione identifica l'ordine assoluto con il quale vengono inseriti nel menù, quindi non ci devono essere voci duplicate e i valori devono essere incrementali da 1 a N.

Per capire meglio vi consiglio di scaricare l'esempio e analizzarlo, è più facile da farlo che dirlo. Buona programmazione.

02 Nov 2011 - TTreeView

Written by xinyiman Novembre 02, 2011, 10:27:00 am 15529 Views Rating: 0 (0 Rates) Print

A volte può nascere l'esigenza di creare dei menù laterali, e il modo più semplice per crearli è attraverso l'oggetto TTreeView che contiene una struttura ad albero, segue un esempio e al fondo trovate il link all'esempio da scaricarvi per analizzarlo e giocarci.

unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

{ TForm1 }

TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    TreeView1: TTreeView;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    Procedure DeleteNode(Node:TTreeNode);
private
    { private declarations }
public
    { public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
     TreeView1.Items.Add(nil,'Primo');
     TreeView1.Items.AddChild(TreeView1.Items.GetLastNode,'1');
     TreeView1.Items.AddChild(TreeView1.Items.GetLastNode,'2');
     TreeView1.Items.AddChild(TreeView1.Items.GetLastNode,'3');
     TreeView1.Items.Add(nil,'Secondo');
     TreeView1.Items.AddChild(TreeView1.Items.GetLastNode,'4');
     TreeView1.Items.AddChild(TreeView1.Items.GetLastNode,'5');
     TreeView1.Items.AddChild(TreeView1.Items.GetLastNode,'6');
     TreeView1.Items.Add(nil,'Terzo');
     TreeView1.Items.AddChild(TreeView1.Items.GetLastNode,'fine');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
s: string;
begin
// if there is no nodes, create a root node with a parent of Nil
if TreeView1.Items.Count = 0 then
    begin
      Treeview1.Items.Add (nil,'Root Node');
      exit;
    end;

// Set up a simple text for each new node - Node1 , Node2 etc
i := treeview1.Items.Count;
s := 'Node ' + inttostr(i);
//Add a new node to the currently selected node
if TreeView1.Selected <> nil then
    Treeview1.Items.AddChild(Treeview1.Selected ,s);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if TreeView1.Selected = nil then exit;
//If selected node has child nodes, first ask for confirmation
If treeview1.Selected.HasChildren then
    if messagedlg('Delete node and all children ?',mtConfirmation,
                 [mbYes,mbNo],0) <> mrYes then exit;
DeleteNode(TreeView1.Selected);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
     ShowMessage(TreeView1.Selected.GetTextPath);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
     ShowMessage(TreeView1.Selected.Text);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
     ShowMessage('Indice assoluto: ' + IntToStr(TreeView1.Selected.AbsoluteIndex));
end;

//A procedure to recursively delete nodes
Procedure TForm1.DeleteNode(Node:TTreeNode);
begin
while Node.HasChildren do DeleteNode(node.GetLastChild);
TreeView1.Items.Delete(Node) ;
end;

end.

Link: www.lazaruspascal.it/esempi/TTreeView.zip