Italian community of Lazarus and Free Pascal

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.
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

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.

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

Introduzione
Buongiorno, oggi vi insegnerò come utilizzare al meglio tutte le unità esterne, tra le quali mouse, stampante, scanner...
Inizio a dirvi subito che gli esempi e i termini che si utilizzeranno durante la guida saranno fedeli al free-pascal.

Ecco le librerie:

Keyboard Tastiera (funzioni avanzate)/Joystick (qualsiasi tipo)
Mouse Mouse/Tavola grafica      
Printer Stampante/Plotter
//      Unità memoria esterne (PenDrive,Disco,Floppy ecc.)

Cercando con Google si possono trovare link per lo scaricamento di queste appartenenti alla rtl (run time library)

Keyboard
Ovviamente, appiamo bene che per input pascal, si utilizza read(X:String)/readln(X:String), ma per delle funzioni avanzate della tastiera, usare la libreria Keyboard é fondamentale. Molti di voi sicuramente saranno perplessi e si chiederanno cosa si potrebbe fare con queste funzioni AVANZATE, ed é per questo che descriverò subito la loro utilità:

• Utilizzare tasti particolari (come F12 o pag. su o up (freccietta) senza l'utilizzo delle direttive
• Utilizzare un qualsiasi tipo di joystick

Per inizializzare il driver della tastiera o joystick utilizzare la procedura InitKeyboard, per disattivarlo DoneKeyboard, entrambe senza parametri.

La maggior parte delle costanti della libreria son tasti particolari:

KbdF1        F1
KbdF2        F2
KbdF3        F3
KbdF4        F4
ecc.
KbdAlt        Alt
KbdCtrl      Crtl  
KbdApps   Menù principale
KbdDown Freccetta Giù      
KbdUp       Freccietta Sù        
KbdRight  Freccetta Destra      
KbdLeft     Freccetta Sinistra  
KbdPgDN Pagina Giù        
KbdPgUP  Pagina Su
KbdHome Home
KbdShift    Shift            

KbdDelete          Nascondi carattere                          KbdInsert           Fai apparire carattere

Per maggiori dettagli: http://www.freepascal.org/docs-html/rtl/keyboard/index.html

Mouse
Come dice la libreria stessa, mouse serve per utilizzare in modo perfetto il mouse. Inizio subito con un esempio di codice:

Program EsmpioMouse;
Uses Graph,Mouse;
Var X,Y:integer;

Begin
Gd:=detect;
InitGraph(Gd,Gm,'C//:FPC');
RestetMouse;
SetMouseWindow(0,0,1000,1000);
{Ecco un bottone}
Rectangle(0,0,100,100);
{Diamogli il valore di bottone per il mouse}
X:=GetmouseX;
Y:=GetmouseY;
If ((X>0) and (Y>0) and (X<100) and (Y<100) then
Write(Fine programma);
Readln;
Resetmouse;
End.


Ecco le funzioni:
Resetmouse  Restetta il mouse, lo inizializza o lo chiude, da usare all'inizio e alla fine per il corretto funzionamento della prossima funzione.
Setmousewindows  In collaborazione con resetmouse da le coordinate di un rettangolo limite delle operazioni col mouse.
GetmouseX/Y Mi sembra abbastanza ovvio guardando il codice: Restituisce la posizione del mouse rispetto all'asse X o Y.

Il programma è molto incompleto anche se funzionante, mancano:
Left/Rightpressed Restituisce true se premuto il tasto sinistro o destro (left/right) del mouse.
Mouseinstalled: Restituisce true se installato un mouse.

Per concludere, la tavola grafica è molto semplice da usare, basta registrare in memoria la posizione del click del mouse e subito dopo rispondere cambiando il colore di quel pixel o di quei pixel. Infatti la maggior parte delle tavole grafiche sono corrispondenti ai driver dei mouse.

Per maggiori dettagli:

Siamo giunti finalmente alla libreria più attesa, printer che permette di stampare da stampante (o plotter) testi in/output.
Ecco come fare, in maniera molto semplice:

Initprinter: Inizializza driver stampante o plotter;
Assinglst: stampa testo (parametro);
IsLstAvaiable: controlla se c'è un driver stampante o plotter installato;

Nulla di più semplice, ma per dettagli: http://www.freepascal.org/docs-html/rtl/printer/index-5.html

Altro
Una volta inserita un'unità esterna, essa sarà parte di quella interna quindi per aprire unità esterne, basta inserirle nel computer e aprirle con una directory normale.
Parlando in termini di windows, però, c'è un cambiamento: Il prefisso "C:" cambia e diventa

E: Per le SD card
D: Per i compact disk (DVD RW)
Z: Per le memory card
F: Per le pendrive

Sempre con windows, si può determinare un prefisso di unità esterna, aprendo "computer" o "risorse del computer" (a seconda delle versioni) e vedendo il nome dell'unità appena inserita seguito dal prefisso tra parentesi.
Per altri sistemi operativi, ci sono altri modi sempre semplici.


Vi auguro un buon uso di queste funzioni nei vostri futuri programmi.

Capita spesso che si debba lavorare con le directory e i loro contenuti. Lazarus/Free Pascal permette queste operazioni in maniera facile ed intuitiva.

Segue un piccolo esempio di una Form con un Button (Nome=Button1) e una ListBox(Nome=ListBox1), quando si preme sul button1 il programma legge tutto il contenuto delle cartella in cui si trova l'eseguibile rinomina tutti i file (di 21 caratteri, estensioni comprese) in esso contenuti togliendo i primi 4 caratteri partendo da sinista.

Segue l'esempio, spero possa essere utile a qualcuno.

unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
   Info : TSearchRec;
   Count : Longint;
   fecha, fecha2:Tdate;
   fechatmp, fechatmp2:longint;
   Spazio: int64;
   filename:string;
   PercIncrem: double;
   Percorso, NuovoNome: string;
   k: integer;
begin
           Percorso:=Application.Location;
           //se volessi leggere un altra cartella dovrei scrivere: If FindFirst (NomeAltraDirectory + '*',faAnyFile and faDirectory,Info)=0 then
           If FindFirst ('*',faAnyFile and faDirectory,Info)=0 then
           begin
                Repeat
                      With Info do
                      begin
                           if ((Name='.') OR (Name='..')) then
                           begin

                           end
                           else
                           begin
                                If (Attr and faDirectory) = faDirectory then
                                begin
                                     //è una dir e la ignoro
                                end
                                else

                                begin

                                        Spazio:=size; //salvo la dimensione del file (non la uso ma è per far vedere che c'è la possibilità)

                                     filename:=Percorso + Name;

                                     if Length(name)=21 then
                                     begin
                                          NuovoNome:=RightStr(Name,Length(Name)-4);

                                          ListBox1.Items.Add(filename + ' --> ' + NuovoNome);
                                          RenameFile(filename, NuovoNome);
                                     end;

                                end;
                           end;
                      end;
                Until FindNext(info)<>0;
           end;
           FindClose(Info);
           ShowMessage('Terminato');
end;

end.