Archivi Categorie: Delphi

Il buon vecchio Delphi, e (perché no?) anche un po di Pascal.

Puntatori alberi e ricorsività parte ][

Rieccomi :) con la seconda parte dei miei mini articoli su Delphi. I simpatizzanti della mela morsicata mi perdoneranno per aver usato ][ al posto del numero 2, ma il mio primo computer è stato un Apple ][ e la tentazione è stata troppo grande :)
La prima puntata della saga è qui. Partendo dal primo articolo ho pensato di aggiungere l’implementazione di un design pattern, il singleton.
Lo scopo del singleton, che è un design pattern creazionale, è quello di garantire la creazione di una sola istanza di una particolare classe. Il link a wikipedia è qui. Nell’esempio precedente il singleton potrebbe esserci utile perché pensando alla nostra classe StandardTreeGest in un contesto più ampio, quindi come parte di un progetto più complesso scritto da molti programmatori, ci troveremmo a doverla istanziare in più punti. Certo potremmo dichiarare una bella variabile globale :) (male… molto male chi lo ha pensato?) ma questa non ci garantirebbe dall’instanziarla più volte e quindi poi trovarci con una struttura dati inconsistente e con anomalie molto molto “stravaganti”.

Cercando in giro non ho trovato molti esempi di singleton in Delphi. I primi risultati della mia ricerca sono stati:

- questo che però è stato risolto usando un’interfaccia e dove si elogiava una soluzione C# definendola elegante… Delphi si basa sul Pascal, ma non è un linguaggio vecchio :) abbiamo anche i tipi generici da Delphi 2009
- Altra soluzione è questa (per Delphi 5) ma utilizza un singleton “strano”… con una tecnica di reference count.

Avendo comprato un bel libro sui design pattern (da non leggere la sera :) specialmente dopo una pizza ai 4 formaggi) ho voluto fare (o almeno ci ho provato) il “preciso” copiando il codice C++

#include <iostream>
 
#define null 0
 
class singleton {
  private:
    static singleton* instance_ptr;

  protected:
    singleton() { };

  public:
    ~singleton() {};
    static singleton* get_instance() {
      if (instance_ptr == null) {
        instance_ptr = new singleton;
      }
      return instance_ptr;
    }
};
 
// initialize pointer
singleton* singleton::instance_ptr = null;

Che in Delphi verrà scritto invece così:

  Singleton = class
    strict private
      // Singleton
      class var
        pInstance: Singleton;

    strict protected
      constructor Create; virtual;

    public
      destructor Destroy; override;
      class function getInstance: StandardTreeGest;
  end;

Ok descriviamo il codice Delphi. Per prima la bellissima parola chiave strict che serve a rendere veramente privati e protetti i dati membro… perché le parole private e protected non valgono per classi all’interno della stessa unit. Tanto per intenderci potete vedere questo codice sorgente che ho copiato da Stack Overflow:

type
  TFather = class
  private
    FPriv : integer;
  strict private
    FStrPriv : integer;
  protected
    FProt : integer;
  strict protected
    FStrProt : integer;
  public
    FPublic : integer;
  end;

  TSon = class(TFather)
  public
    procedure DoStuff;
  end;

  TUnrelated = class
  public
    procedure DoStuff;
  end;

procedure TSon.DoStuff;
begin
  FProt := 10;       // Legal, as it should be. Accessible to descendants.
  FPriv := 100;      // Legal, even though private. This won't work from another unit!
  FStrictPriv := 10; // <- Compiler Error, FStrictPrivFather is private to TFather
  FPublic := 100;    // Legal, naturally. Public members are accessible from everywhere.
end;

procedure TUnrelated.DoStuff;
var
  F : TFather;
begin
  F := TFather.Create;
  try
    F.FProt := 10;     // Legal, but it shouldn't be!
    F.FStrProt := 100; // <- Compiler error, the strict keyword has "made the protection work"
    F.FPublic := 100;  // Legal, naturally.
  finally
    F.Free;
  end;
end;

Qui si parla di un bug del compilatore… ma nell’help ufficiale è una features :) ovviamente!!!
Poi incontriamo un’altra parolina magica class var questa ci permette di definire dei dati membro statici, infatti per il singleton sia il dato membro che la funzione di istanziazione della classe devono essere statici (per poter essere richiamati senza istanziare una classe, ma dico una cosa ovvia vero…?).

La Unit TreeGest del nostro esempio risulterà quindi essere questa:

unit TreeGest;

interface

type
  pElement = ^Element;

  Element = record
    iValue: integer;
    pLeftElement, pRightElement: pElement;
  end;

  StandardTreeGest = class
    strict private
      // Singleton
      class var
        pInstance: StandardTreeGest;

    strict protected
      constructor Create; virtual;

    private
      // Tree managment
      pRoot: pElement;

      function CreateNewElem(ext_iValue: integer): pElement;
      function InsertSorted(ext_iValue: integer; var pCurrElem: pElement): pElement;
      function ReadFromMinimum(pCurrElem: pElement): string;

      procedure DeleteAll_From(pCurrElem: pElement);

    public
      function AddElement(ext_iValue: integer): pElement;
      function SortAscending: string;

      procedure DeleteAll;

      destructor Destroy; override;

      // Singleton
      class function getInstance: StandardTreeGest;
  end;

implementation

{ StandardTreeGest }

uses
  System.SysUtils;

constructor StandardTreeGest.Create;
begin
  pRoot := nil;
end;

destructor StandardTreeGest.Destroy;
begin
  if assigned(pRoot) then
    DeleteAll;
end;

class function StandardTreeGest.getInstance: StandardTreeGest;
begin
  if (pInstance = nil) then
    pInstance := StandardTreeGest.Create;

  result := pInstance;
end;

procedure StandardTreeGest.DeleteAll;
begin
  DeleteAll_From(pRoot);
  pRoot := nil;
end;

procedure StandardTreeGest.DeleteAll_From(pCurrElem: pElement);
begin
  if pCurrElem <> nil then
  begin
    DeleteAll_From(pCurrElem.pLeftElement);
    DeleteAll_From(pCurrElem.pRightElement);
    Dispose(pCurrElem);
  end
end;

function StandardTreeGest.AddElement(ext_iValue: integer): pElement;
var
  pAddedElement: pElement;

begin
  if pRoot = nil then
  begin
    pRoot := CreateNewElem(ext_iValue);
    pAddedElement := pRoot;
  end
  else
    pAddedElement := InsertSorted(ext_iValue, pRoot);

  result := pAddedElement;
end;

function StandardTreeGest.CreateNewElem(ext_iValue: integer): pElement;
var
  pNewElement: pElement;
begin
  try
    new(pNewElement);
    pNewElement.iValue := ext_iValue;
    pNewElement.pLeftElement := nil;
    pNewElement.pRightElement := nil;
  except
    pNewElement := nil;
  end;

  result := pNewElement;
end;

function StandardTreeGest.InsertSorted(ext_iValue: integer; var pCurrElem: pElement): pElement;
var
  pResultElem: pElement;

begin
  if (pCurrElem = nil) then
  begin
    pResultElem := CreateNewElem(ext_iValue);
    pCurrElem := pResultElem;
  end
  else
    if (ext_iValue < pCurrElem.iValue) then
      pResultElem := InsertSorted(ext_iValue, pCurrElem.pLeftElement)
    else
      pResultElem := InsertSorted(ext_iValue, pCurrElem.pRightElement);

  result := pResultElem;
end;

function StandardTreeGest.SortAscending: string;
var
  sNode: string;

begin
  sNode := ReadFromMinimum(pRoot);
  if (sNode <> '') then
    result := Copy(sNode, 3, length(sNode) - 2)
  else
    result := '';
end;

function StandardTreeGest.ReadFromMinimum(pCurrElem: pElement): string;
var
  sOrderedTree: string;

begin
  if pCurrElem <> nil then
  begin
    sOrderedTree := ReadFromMinimum(pCurrElem.pLeftElement) + ' - ' + IntToStr(pCurrElem.iValue);
    sOrderedTree := sOrderedTree + ReadFromMinimum(pCurrElem.pRightElement);
  end
  else
    sOrderedTree := '';

  result := sOrderedTree;
end;

end.

Oltre ad aver implementato il singleton rispetto a quella dello scorso post ho aggiunto un blocco try…except al momento dell’allocazione della memoria del nuovo nodo dell’albero. Nel mondo ideale la memoria è illimitata, ma in quello reale finisce sempre sul più bello e la scorsa volta mi sono dimenticato di gestire l’eccezione.
Il programma avrà l’aspetto seguente:

pgm_singleton

Che a parte un bottone in più… è uguale al precedente… che farà il nuovo bottone?

procedure TfrmMain.btnAddElem2Click(Sender: TObject);
var
  pTreeGestLocal: StandardTreeGest;
  iValue, iCode: integer;

begin
  pTreeGestLocal := StandardTreeGest.getInstance;

  Val(txtValue.Text, iValue, iCode);

  if ((trim(txtValue.Text) <> '') and (iCode = 0)) then
  begin
    pTreeGestLocal.AddElement(StrToInt(txtValue.Text));
    txtValue.Clear;
    txtValue.SetFocus;
  end
end;

Semplicemente permette di verificare il singleton, aggiungendo direttamente un elemento all’albero. Notate che uso solo varibili locali e che la getInstance mi restituisce sempre il riferimento all’unica classe StandardTreeGest creata.

Il codice sorgente lo potete scaricare qui.

Alla prossima :)

Puntatori, alberi e ricorsività

Rieccomi dopo tanto. Questo è il primo articolo di una piccola serie… facciamo miniserie di 3 o forse 4 puntate veloci.
Qualche tempo fa ho fatto un colloquio per una ditta all’estero, il colloquio prevedeva anche un test pratico. 40 minuti di tempo per creare in Delphi un albero, popolarlo e stamparne gli elementi.
L’albero conteneva numeri, a partire dalla radice i numeri minori del nodo corrente venivano memorizzati nel ramo a sinistra, quelli maggiori del nodo corrente invece nel ramo di destra. La lettura ovviamente doveva restituire gli elementi in maniera ordinata.
Facendo un esempio pratico, dovendo inserire i numeri 10 – 6 – 4 – 3 – 8 -12 avremo avuto un albero come questo:

Tree

Insomma :) il calssico esercizio di teoria sugli alberi, dov’era l’inghippo? Si avevano a disposizione solo 40 minuti! E il tempo vola.

Devo ammettere che il test era proprio ben fatto. Dopo averlo superato ho pensato che in realtà fosse troppo facile, ma non lo era affatto. Per poterlo passare o si conosceva la teoria o non si sarebbe potuto trovare nulla su google da copiare ed incollare. Gli elementi da inserire erano:

- Puntatori
- Gli alberi
- La ricorsione

I puntatori non sono così usati in Delphi e non ho mai capito bene perché sono indicanti da molti sviluppatori come il male di ogni software. Agli albori di Java una delle frasi che mi aveva divertito di più era:
“La gestione della memoria è troppo importante per lasciarla agli sviluppatori. La gestione della memoria è troppo importante per lasciarla al software”.
Chissà chi aveva ragione…

Sugli alberi dipende molto da che software sviluppate, io non li ho più usati dai tempi della scuola… troppo software gestionale :) con le sue query SQL.
Riguardo la ricorsione… siamo quasi come i puntatori; un altro di quegli argomenti amati e odiati, la ricorsione (qui il link a wikipedia) risolve semplicemente alcune tipologie di problemi ma al tempo stesso non è performante.

Tornando a noi, il programmino finale è quello nella figura di seguito:

Il programma

Ok è esteticamente bruttino, ma abbiate pietà, comprensione, umanità un principio di cataratta :) … fare le cornicette di notte non mi entusiasma :) Il suo funzionamento è semplice. Si aggiungono gli elementi alla TListBox premendo il bottone “Add Element” che sposta l’elemento dalla TEdit “value” alla lista, una volta che abbiamo popolato a dovere quest’ultima il bottone “Create tree” genererà l’albero.
Il bottone “Sorted elements” scriverà gli elementi dal più piccolo al più grande :) nel componente TEdit a fianco del bottone.

L’implementazione della classe StandardTreeGest prevederà le funzioni pubbliche:

public
  function AddElement(ext_iValue: integer): pElement;
  function SortAscending: string;

Per aggiungere un elemento e per estrarre la lista degli elementi inseriti in maniera ordinata. Queste 2 funzioni saranno le “interfacce” pubbliche delle seguenti funzioni private:

function InsertSorted(ext_iValue: integer; var pCurrElem: pElement): pElement;
function ReadFromMinimum(pCurrElem: pElement): string;

Che opereranno realmente sull’albero. Andando ad evidenziare i punti problematici elencati prima (puntatori, alberi e ricorsione) vediamo che ogni nodo di un albero è formato da 2 puntatori ad altri nodi (uno al ramo sinistro e uno al destro) e dal valore del nodo stesso. Questo in Delphi si dichiara così:

type
  pElement = ^Element;

  Element = record
    iValue: integer;
    pLeftElement, pRightElement: pElement;
  end;

Abbiamo quindi le funzioni pubbliche per l’accesso all’albero che richiameranno quelle private che saranno anche quelle ricorsive.

function StandardTreeGest.AddElement(ext_iValue: integer): pElement;
var
  pAddedElement: pElement;

begin
  if pRoot = nil then
  begin
    pRoot := CreateNewElem(ext_iValue);
    pAddedElement := pRoot;
  end
  else
    pAddedElement := InsertOrdered(ext_iValue, pRoot);

  result := pAddedElement;
end;

function StandardTreeGest.SortAscending: string;
var
  sNode: string;

begin
  sNode := ReadFromMinimum(pRoot);
  if (sNode <> '') then
    result := Copy(sNode, 3, length(sNode) - 2)
  else
    result := '';
end;

Come vedete fanno ben poche cose principalmente legate al controllo del nodo radice dell’albero. Il lavoro vero lo fanno le funzioni private:

function CreateNewElem(ext_iValue: integer): pElement;
function InsertSorted(ext_iValue: integer; var pCurrElem: pElement): pElement;
function ReadFromMinimum(pCurrElem: pElement): string;

Con il loro codice sorgente:

function StandardTreeGest.CreateNewElem(ext_iValue: integer): pElement;
var
  pNewElement: pElement;
begin
  new(pNewElement);
  pNewElement.iValue := ext_iValue;
  pNewElement.pLeftElement := nil;
  pNewElement.pRightElement := nil;

  result := pNewElement;
end;

function StandardTreeGest.InsertSorted(ext_iValue: integer; var pCurrElem: pElement): pElement;
var
  pResultElem: pElement;

begin
  if (pCurrElem = nil) then
  begin
    pResultElem := CreateNewElem(ext_iValue);
    pCurrElem := pResultElem;
  end
  else
    if (ext_iValue < pCurrElem.iValue) then
      pResultElem := InsertOrdered(ext_iValue, pCurrElem.pLeftElement)
    else
      pResultElem := InsertOrdered(ext_iValue, pCurrElem.pRightElement);

  result := pResultElem;
end;

function StandardTreeGest.ReadFromMinimum(pCurrElem: pElement): string;
var
  sOrderedTree: string;

begin
  if pCurrElem <> nil then
  begin
    sOrderedTree := ReadFromMinimum(pCurrElem.pLeftElement) + ' - ' + IntToStr(pCurrElem.iValue);
    sOrderedTree := sOrderedTree + ReadFromMinimum(pCurrElem.pRightElement);
  end
  else
    sOrderedTree := '';

  result := sOrderedTree;
end;

A parte la CreateNewElem le altre funzioni sono ricorsive cioè richiamano se stesse dal loro interno, questo permette ad esempio alla ReadFromMinimum di leggere tutti i nodi a sinistra e una volta arrivato all’ultimo elemento di “riavvolgersi” su se stessa e passare alla lettura del ramo destro del nodo corrente. Tutto questo perché le chiamate a funzione e le variabili locali in esse contenute vengono memorizzate sullo stack. Da qui la lentezza e la grande occupazione di memoria delle funzioni ricorsive a cui si contrappone la drammatica semplicità del codice scritto.

Volevo richiamare la vostra attenzione sulla creazione di un nuovo record nella funzione CreateNewElem

  new(pNewElement);

avete visto l’istruzione new… mica vorrete lasciarla senza la sua dispose!!! :) I puntatori fanno casini quando ci dimentichiamo di deallocarli o magari li usiamo senza allocarli, ma non sono così cattivi in fondo.
La funzione di “ripulitura” è la DeleteAll richiamata anche da dentro il distruttore della classe StandardTreeGest. Il codice completo di quest’ultima è il seguente:

unit TreeGest;

interface

type
  pElement = ^Element;

  Element = record
    iValue: integer;
    pLeftElement, pRightElement: pElement;
  end;

  StandardTreeGest = class
    private
      pRoot: pElement;

      function CreateNewElem(ext_iValue: integer): pElement;
      function InsertSorted(ext_iValue: integer; var pCurrElem: pElement): pElement;
      function ReadFromMinimum(pCurrElem: pElement): string;

      procedure DeleteAll_From(pCurrElem: pElement);

    public
      function AddElement(ext_iValue: integer): pElement;
      function SortAscending: string;

      procedure DeleteAll;

      constructor Create; virtual;
      destructor Destroy; override;

  end;

implementation

{ StandardTreeGest }

uses
  System.SysUtils;

constructor StandardTreeGest.Create;
begin
  pRoot := nil;
end;

destructor StandardTreeGest.Destroy;
begin
  if assigned(pRoot) then
    DeleteAll;
end;

procedure StandardTreeGest.DeleteAll;
begin
  DeleteAll_From(pRoot);
  pRoot := nil;
end;

procedure StandardTreeGest.DeleteAll_From(pCurrElem: pElement);
begin
  if pCurrElem <> nil then
  begin
    DeleteAll_From(pCurrElem.pLeftElement);
    DeleteAll_From(pCurrElem.pRightElement);
    Dispose(pCurrElem);
  end
end;

function StandardTreeGest.AddElement(ext_iValue: integer): pElement;
var
  pAddedElement: pElement;

begin
  if pRoot = nil then
  begin
    pRoot := CreateNewElem(ext_iValue);
    pAddedElement := pRoot;
  end
  else
    pAddedElement := InsertSorted(ext_iValue, pRoot);

  result := pAddedElement;
end;

function StandardTreeGest.CreateNewElem(ext_iValue: integer): pElement;
var
  pNewElement: pElement;
begin
  new(pNewElement);
  pNewElement.iValue := ext_iValue;
  pNewElement.pLeftElement := nil;
  pNewElement.pRightElement := nil;

  result := pNewElement;
end;

function StandardTreeGest.InsertSorted(ext_iValue: integer; var pCurrElem: pElement): pElement;
var
  pResultElem: pElement;

begin
  if (pCurrElem = nil) then
  begin
    pResultElem := CreateNewElem(ext_iValue);
    pCurrElem := pResultElem;
  end
  else
    if (ext_iValue < pCurrElem.iValue) then
      pResultElem := InsertSorted(ext_iValue, pCurrElem.pLeftElement)
    else
      pResultElem := InsertSorted(ext_iValue, pCurrElem.pRightElement);

  result := pResultElem;
end;

function StandardTreeGest.SortAscending: string;
var
  sNode: string;

begin
  sNode := ReadFromMinimum(pRoot);
  if (sNode <> '') then
    result := Copy(sNode, 3, length(sNode) - 2)
  else
    result := '';
end;

function StandardTreeGest.ReadFromMinimum(pCurrElem: pElement): string;
var
  sOrderedTree: string;

begin
  if pCurrElem <> nil then
  begin
    sOrderedTree := ReadFromMinimum(pCurrElem.pLeftElement) + ' - ' + IntToStr(pCurrElem.iValue);
    sOrderedTree := sOrderedTree + ReadFromMinimum(pCurrElem.pRightElement);
  end
  else
    sOrderedTree := '';

  result := sOrderedTree;
end;

end.

Il sorgente di tutto il programma lo trovate qui

Come potete vedere ho creato il costruttore e il distruttore… ho fatto lo stesso anche con la form del main, so che con le form avrei potuto usare l’evento oncreate per fare le mie inizializzazioni ma sono un po “stagionato” :)

Concludo questo primo articolo dicendo che le poche righe scritte non sono certo esaustive, gli alberi sono materia complessa se non di più, ma la mia idea è di buttare una pietra nell’acqua e far muovere un po’ le cose. Spiegare quello che so e anche imparare per cui se avete commenti, suggerimenti o correzioni non esitate a scrivere :)

Delphi XE2

Rieccomi a bomba su Delphi XE2 e Firemonkey. Mi sembra di essere un post della serie Frattanto… o una puntata di Dallas, non ho mai scritto così tanto e tanto velocemente sul blog. Dopo un fine settimana di mail con Paolo che aveva commentato il precedente post ho corretto alcuni miei errori.
Nel test di firemonkey ho impropriamente usato un oggetto TRectangle, la cui creazione inseriva un overhead rispetto alla versione VCL che usava una funzione nativa dell’oggetto Canvas.
In soldoni :) il codice

...
Layout1.Canvas.BeginScene;
with TRectangle.Create(Layout1) do
begin
...

Spende molto tempo a creare l’oggetto che al tempo stesso è paragonabile ad un oggetto d’interfaccia ed è per questo che il bottone “Disegna” veniva ricoperto. Quindi dopo una chicchierata via mail con Paolo e qualche “inno” sacro notte tempo sono riuscito a scrivere sul mio oggetto canvas in modalità VCL style e a rendere quindi i due sorgenti comparabili.


constructor DrawFillRect.Create(ext_Image: TImage);
begin
  inherited Create(true);

  Layout1 := ext_Image;
  IntWidth := Round(Layout1.Width);
  IntHeight := Round(Layout1.Height);
  arrayColor[1] := TAlphaColorRec.Alpha;
  arrayColor[2] := TAlphaColorRec.Aliceblue;
...
...
  arrayColor[153] := TAlphaColorRec.Yellow;
  arrayColor[154] := TAlphaColorRec.Yellowgreen;

end;

procedure DrawFillRect.Execute;
var
  i: integer;
  dStartTime, dEndTime: TDateTime;

begin

  dStartTime := now;
  iShape := 1;

  for i := 1 to MAX_NUM_OF_SHAPES do
    synchronize(aggiorna);

  dEndTime := now;

  showmessage('Inizio   : ' + formatDateTime('dd-mm-yyyy hh:nn:ss:zzz', dStartTime) + #13#10 +
              'Fine     : ' + formatDateTime('dd-mm-yyyy hh:nn:ss:zzz', dEndTime) + #13#10 +
              'Trascorso: ' + formatDateTime('hh:nn:ss:zzz', dEndTime - dStartTime) + #13#10);
end;

procedure DrawFillRect.aggiorna;
var
  iColor, iXCoord, iYCoord: integer;

  MyRect, MyDrawRect: TRectF;
  i: integer;

begin
  with Layout1 do
  begin
    Canvas.BeginScene;
    MyRect.Create(RandomRange(0, IntWidth), RandomRange(0, IntHeight),
    RandomRange(0, IntWidth), RandomRange(0, IntHeight));
    Canvas.fill.Color := arrayColor[RandomRange(1, 154)];
    Canvas.FillRect(MyRect, 0, 0, AllCorners, 100);
    Canvas.EndScene;
  end;
end;

Notate le istruzioni:

Canvas.BeginScene;
...
Canvas.EndScene;

se non si mettono non verrà disegnato nulla :( (sigh questo è stato il mio grave errore). Comunque anche in questo caso il tempo non brilla… siamo a 31,117 s per cui non troppo meglio di prima :( Inoltre spostando la mail con il thread in esecuzione la creazione dei rettangoli si blocca. Paolo mi suggerisce quindi di mettere il loop all’interno del blocco BeginScene…EndScene. Ottenendo quindi il seguente codice:

constructor DrawClearRectIntFor.Create(ext_Image: TImage);
begin
  inherited Create(true);

  Layout1 := ext_Image;
  IntWidth := Round(Layout1.Width);
  IntHeight := Round(Layout1.Height);
  arrayColor[1] := TAlphaColorRec.Alpha;
  arrayColor[2] := TAlphaColorRec.Aliceblue;
...
...
  arrayColor[153] := TAlphaColorRec.Yellow;
  arrayColor[154] := TAlphaColorRec.Yellowgreen;

end;

procedure DrawClearRectIntFor.Execute;
var
  i: integer;
  dStartTime, dEndTime: TDateTime;

begin

  dStartTime := now;
  iShape := 1;
  synchronize(aggiorna);

  dEndTime := now;

  showmessage('Inizio   : ' + formatDateTime('dd-mm-yyyy hh:nn:ss:zzz', dStartTime) + #13#10 +
              'Fine     : ' + formatDateTime('dd-mm-yyyy hh:nn:ss:zzz', dEndTime) + #13#10 +
              'Trascorso: ' + formatDateTime('hh:nn:ss:zzz', dEndTime - dStartTime) + #13#10);
end;

procedure DrawClearRectIntFor.aggiorna;
var
  iColor, iXCoord, iYCoord: integer;

  MyRect, MyDrawRect: TRectF;
  i: integer;

begin
  for i := 1 to MAX_NUM_OF_SHAPES do
    with Layout1.Bitmap do
    begin
      MyRect.Create(RandomRange(0, IntWidth), RandomRange(0, IntHeight),
      RandomRange(0, IntWidth), RandomRange(0, IntHeight));
      MyDrawRect.Create(MyRect.Left-1, MyRect.Top-1, MyRect.Right+1,MyRect.Bottom+1);
      ClearRect(MyDrawRect, arrayColor[9] );
      ClearRect(MyRect, arrayColor[RandomRange(1, 154)] );
      BitmapChanged;
    end;
end;

I risultati cambiano drasticamente solo 0,016 s ma non vedo più la fase di disegno, mi compare direttamente la chiazza di rettangoli colorati. Praticamente il blocco BeginScene..EndScene mi apre e chiude una fase di disegno che verra riportata a video… l’help ufficiale riporta per la EndScene:

Description

Notifies the TCanvas object that the drawing is complete.

Call EndScene after the drawing on the TCanvas is complete.

To start the drawing session, call BeginScene.

Intanto Embarcadero sta valutando le mie segnalazioni (si mi hanno risposto) e anche loro sono sorpresi. Mi hanno detto che a breve uscira il quarto update di Firemonkey.
Il mio amico Juhan mi ha chiesto un parere finale a tutti questi articoli… Come ho scritto ad Embarcadero io credo che la Firemonkey sia notevole, aprirà certamente delle enormi possibilità per lo sviluppo multipiattaforma, ma come IT manager non posso proporlo ancora come alternativa alla VCL in ambiente di produzione.
Infatti il prodotto non è ancora maturo e stabile (4 update in poco tempo) e costo elevato di apprendimento (poca documentazione e troppe differenze dalla VCL). Però credo che andrà tenuto d’occhio!!!

Delphi XE2 nuovi test

Delphi XE2 altri test!

Seconda serie di test su Delphi XE2 e Firemonkey… Vi anticipo che i risultati non sono affatto buoni. Sono già al 3 fazzoletto zuppo di lacrime :(
Che dire, uno dei cavalli di battaglia della pubblicità di Firemonkey è stato “More power and performance… with native CPU performance and GPU powered visuals on PC” Per cui mi sono detto “e stressiamo questa GPU!!!”

Dato che il tempo è tiranno è il lavoro mi ruba anche l’anima diciamo che il tentativo di stress della GPU si limita al 2D e forse non si stressa neanche molto… ma provare non nuoce.

Cosa ho fatto? Ho creato 3 diverse versioni dello stesso programma, un thread secondario che disegna 1.000 rettangoli filled (cioè colorati internamente) in ambiente VCL standard (quello che viene definito lento e vecchio), in ambiente Direct 2D (quindi veloce e ottimizzato per windows) e con Firemonkey (da quello che racconta Embarcadero dovrebbe usare Direct 2D in ambiente Windows).

Il codice sorgente, riporto solo quello del thread è per la VCL questo:

constructor Draw.Create(ext_Layout: TImage);
begin
  inherited Create(true);

  Layout1 := ext_Layout;

  arrayColor[1] := TColorRec.Aliceblue;
...
...
  arrayColor[154] := TColorRec.Yellowgreen;

end;

procedure Draw.Execute;
var
  i: integer;
  dStartTime, dEndTime: TDateTime;

begin

  dStartTime := now;
  iShape := 1;
  for i := 1 to MAX_NUM_OF_SHAPES do
  begin
    synchronize(aggiorna);
  end;
  dEndTime := now;

  showmessage('Inizio   : ' + formatDateTime( 'dd-mm-yyyy hh:nn:ss:zzz', dStartTime) + #13#10 +
              'Fine     : ' + formatDateTime( 'dd-mm-yyyy hh:nn:ss:zzz', dEndTime) + #13#10 +
              'Trascorso: ' + formatDateTime( 'hh:nn:ss:zzz', dEndTime - dStartTime) + #13#10);
end;

procedure Draw.aggiorna;
var
  iColor, iXCoord, iYCoord: integer;

begin
  Randomize;
  iColor := RandomRange(1, 154);
  iXCoord := RandomRange(0, Layout1.Width);
  iYCoord := RandomRange(0, Layout1.Height);

  Layout1.Canvas.Brush.Color := arrayColor[iColor];

  Layout1.Canvas.Rectangle(iXCoord, iYCoord, 250, 200);
  inc(iShape);
end;

Per il direct 2d questo:

constructor Draw.Create(ext_Layout: TImage);
begin
  inherited Create(true);

  Layout1 := ext_Layout;

  arrayColor[1] := TColorRec.Aliceblue;
...
...
  arrayColor[154] := TColorRec.Yellowgreen;

end;

procedure Draw.Execute;
var
  i: integer;
  dStartTime, dEndTime: TDateTime;
  iColor, iXCoord, iYCoord: integer;

begin

  dStartTime := now;
  INumRect := 1;
  for i := 1 to MAX_NUM_OF_SHAPES do
  begin
    iColor := RandomRange(1, 154);
    iXCoord := RandomRange(0, imgView.Width);
    iYCoord := RandomRange(0, imgView.Height);
    arrayAssignedColor[i] := arrayColor[iColor];
    arrayRect[i] := Rect(iXCoord, iYCoord, 250, 200);
  end;

  synchronize(aggiorna);

  dEndTime := now;

  showmessage('Inizio   : ' + formatDateTime( 'dd-mm-yyyy hh:nn:ss:zzz', dStartTime) + #13#10 +
              'Fine     : ' + formatDateTime( 'dd-mm-yyyy hh:nn:ss:zzz', dEndTime) + #13#10 +
              'Trascorso: ' + formatDateTime( 'hh:nn:ss:zzz', dEndTime - dStartTime) + #13#10);
end;

procedure Draw.aggiorna;
var
  j: integer;

begin

  Layout1 := TDirect2DCanvas.Create(imgView.Canvas, imgView.ClientRect);

  Layout1.BeginDraw;

  Layout1.Pen.Color := clBlack;
  Layout1.Pen.Style := psSolid;

  for j := 1 to MAX_NUM_OF_SHAPES do
  begin
    Layout1.Brush.Color := arrayAssignedColor[j];
    Layout1.FillRect(arrayRect[j]);
  end;

  Layout1.EndDraw;
  Layout1.free;
end;

Per Firemonkey quest’ultimo:

constructor Draw.Create(ext_Layout: TLayout);
begin
  inherited Create(true);

  Layout1 := ext_Layout;
  Test := TRectangle.Create(Layout1);

  arrayColor[1] := TAlphaColorRec.Alpha;
	arrayColor[2] := TAlphaColorRec.Aliceblue;

...
...
  arrayColor[154] := TAlphaColorRec.Yellowgreen;

end;

procedure Draw.Execute;
var
  i: integer;
  dStartTime, dEndTime: TDateTime;

begin

  dStartTime := now;
  iShape := 1;
  for i := 1 to MAX_NUM_OF_SHAPES do
  begin
    synchronize(aggiorna);
  end;
  dEndTime := now;

  showmessage('Inizio   : ' + formatDateTime( 'dd-mm-yyyy hh:nn:ss:zzz', dStartTime) + #13#10 +
              'Fine     : ' + formatDateTime( 'dd-mm-yyyy hh:nn:ss:zzz', dEndTime) + #13#10 +
              'Trascorso: ' + formatDateTime( 'hh:nn:ss:zzz', dEndTime - dStartTime) + #13#10);
end;

procedure Draw.aggiorna;
var
  iColor, iXCoord, iYCoord: integer;

begin
    Layout1.Canvas.BeginScene;
    with TRectangle.Create(Layout1) do
    begin

      iColor := RandomRange(1, 154);
      iXCoord := RandomRange(0, trunc(Layout1.Width));
      iYCoord := RandomRange(0, trunc(Layout1.Height));

      parent := Layout1;
      Fill.Color := arrayColor[iColor];
      Width := 250;
      height := 200;
      Position.X := iXCoord;
      Position.Y := iYCoord;
      //RotationAngle := iShape - 1;
      RotationAngle := 0;
      inc(iShape);
    end;

    Layout1.Canvas.EndScene;
end;

Compilo ed eseguo! Di seguito il risultato per la VCL:

Questo è quello di direct2D:

Questo è FireMonkey:

Anche questa prova è impietosa…

VCL        299 ms
Direct 2D   45 ms
Firemonkey  35,17 s

E’ da notare inoltre che nonostante io abbia definito un frame di visualizzazione i rettangoli del test con firemonkey sono andati a ricoprire anche il bottone che non è più visibile ma è nella stessa posizione degli altri 2 test.
Riguardo al consumo di CPU facendo un confronto spannometrico e usando il gestore di attività di windows ottengo un picco di:

VCL        6%   CPU
Direct 2D  1%   CPU
Firemonkey 3-8% CPU

Per cui Firemonkey ha richiesto più CPU di tutti gli altri con oscillazioni dal 3 all’8 percento. Insomma un disastro… per scrupolo manderò ancora queste prove ad Embarcadero, caso mai non avendo ne help ne documentazione abbia sbagliato ad usare Firemonkey, se ci saranno novità vi racconterò, ma sto ancora aspettando risposta alla mia ultima mail… di 3 mesi fa!

Delphi XE2

La parola Delphi è portatrice di tanti notti insonni passate a divertirmi programmando. Delphi 1 è stata la classica manna discesa dal cielo. Eseguibili piccoli, facilità di sviluppo, insomma nessun pentimento (era il 1995).
La prima conferenza/presentazione Delphi a cui partecipai fu quella di Delphi 4 a Milano, era il 1998. Speaker un noto punto di riferimento nostrano, tante risate e ironia sulla concorrenza targata Microsoft. Vennero presentate le novità, CORBA, DCOM programmazione distribuita… una favola! I punti focali erano i nuovi componenti, l’help, ricordo ancora le parole dell’esperto, per la prima volta sarebbe stato completo perché scritto in contemporanea alla libreria dei componenti.
Riuscii a convincere la mia azienda a comprare la versione enterprise (3.600.000 lire a licenza) e far partire un nuovo sviluppo interno abbandonando Visual Basic. Ad anni di distanza da quella scelta non posso che ammettere che sia stata quella giusta (basta ricordare che da VB versione 3 alla 5 sono cambiate con ogni release le tecnologie per l’accesso alle basi dati Jet, DAO, ADO, OleDB faccio fatica a ricordarle tutte). Però… la strada fu tutta in salita!!!
Ebbene si, lo sviluppo non fu facile. Dovetti installare l’help di delphi 3 perché il nuovo help era inguardabile :( poi lo sviluppo procedette a rilento fino a quando con la patch 1 (grande come l’intera installazione base) non vennero risolti la maggior parte dei problemi.
Venne poi dichiarato in un’altra conferenza (a cui non ero presente) che il rilascio di Delphi 4 era stato anticipato (quindi Borland sapeva che il software non era pronto) per motivi legati al valore delle azioni.
La partenza fu quindi burrascosa, ma poi il mare divenne calmo e le correnti favorevoli :) Il progetto venne convertito da Delphi 4 a delphi 2006 senza quasi modifiche!

Infine a settembre 2011 viene presentato Delphi XE2 che promette di farci scrivere codice portabile anche sui dispositivi Apple! Preso dalla curiosità mi iscrivo all’avento di Milano, sala piena e nel momento in cui salgono sul palco i conferenzieri ho come un dejavu… c’era nuovamente l’esperto nostrano, invecchiato come me :) per fortuna. Gli interventi e le domande furono molto tecnici. Risultato, con molte paure (la conferenza del 1998 mi brucia ancora) decisi di mettere mano al portafoglio e comprarne una copia, la curiosità era grande.
La prima scoperta… fu negativa e riguardò l’aumento dei costi di licenza… con quello che avevo speso per il Rad Studio 2010 compravo solo più Delphi dovevo rinunciare al mio caro C++… ma superato il trauma economico mi sono lanciato sul pezzo forte la libreria FireMonkey
Questa libreria permette di scrivere applicativi multipiattaforma, visto che le form e tutti i componenti visuali sono “disegnati” usando i motori grafici dei sistemi su cui funziona l’eseguibile. Nel caso di windows DirectX per OSX invece OpenGL. Il dettaglio del funzionamento lo lascio ai vari siti :) quello che mi premeva vedere è se potevo realizzare le mie applicazioni desktop e vederle funzionare sul mac. Il CDA mi chiedeva giusto giusto un’applicazione per l’IPhone…

Non riporto il codice che sarebbe troppo lungo e pressoché inutilizzabile perché memorizzato nel file descrittivo della form (cioè tutto fatto a design time senza scrivere nulla). In pochi minuti realizzo il mio applicativo VCL (quindi quello che funziona solo sotto windows) che si collega al mio Db postgres e mi fa vedere la mia bella griglia :) come in figura.

Griglia in versione VCL

Notate che il campo des_titolo che è un campo di lookup (quindi una scelta di voci da una tabella elenco) mi fa comparire una tendina sulla griglia con 0 righe di codice.
Provo a fare le stesse cose con la libreria firemonkey. Scopro che il legame tra i componenti visuali e la base dati avviene in modo diverso, più evoluto secondo molti, molto meno intuitivo secondo me :) per cui devo aggiungere i componenti di bind. Il primo demo prevedeva di fare vedere nomi e cognomi in una lista, dopodiche ho pensato che non era bello mostrare anche i cognomi e così ho fatto quello che ho sempre fatto dal 1998 ad oggi, cioè ho rimosso la colonna dalla griglia. In figura vedete il mio ambiente a design time:

Comportamento a design time

Qui invece il mio eseguibile in funzione (è la finestra sotto quella di design time).

Confronto tra design e runtime

Rimango perplesso c’è una colonna che non esiste… Per curiosità provo a rendere invisibile un’altra colonna… il risultato non cambia!!! Provo a guardare l’help e ottengo questa bellissima schermata :(

Help di firemonkey

Dove la riga dell’help riporta “Embarcadero Technologies does not currently have any additional information. Please help us document this topic by using the Discussion page!”. Mi cadono le braccia :( La nuova tecnologia non è supportata neanche da un help e devo dire che un po’ mi innervosisco pensando ai soldi spesi. Non demordo e tolgo dai campi del DB la colonna incriminata :) dicendomi se non la trova più non la farà vedere… il risultato è riportato in figura.

Griglia in Firemonkey

E come potete vedere il comodo campo di lookup che nella VCL funziona in automatico non esiste più.

Il mio giudizio non può che essere negativo, un programmatore VCL con esperienza si trova ad aver a che fare con componenti profondamente diversi da quelli VCL, ma se il cambiamento non spaventa i risultati che si ottengono si. Da settembre data del rilascio siamo già al terzo aggiornamento e i problemi rimangono enormi. L’help non è minimale bensì incompleto e beffardamente mi chiedono di aiutarli a documentare le funzionalità. Mi faranno uno sconto sul prossimo acquisto?
Delphi continua ad essere un ottimo strumento, ma firemonkey non è una libreria ancora matura. Inoltre mi chiedo perché la VCL per l’accesso ai DB fosse intuitiva e semplice mentre Firemonkey non lo possa essere.
Quello che noto è che purtroppo pur rimanendo vero e giustissimo quello che dice il mio amico Juhan:

1) tutti possono sbagliare;
2) intestardirsi a sostenere una posizione insostenibile è –come dire– ecco;
3) per fortuna ci sono gli aggiornamenti; o, anche meglio
4) riscrivi quel pezzo di codice, fai prima.

Lo sviluppo del software sta diventando sempre più “leggero” dove con leggero intendo fatto in maniera superficiale, si tagliano figure importanti come quelle che facevano le analisi e i test funzionali (le persone mica possono essere sostituite da una junit). Si rilasciano versioni per non essere da meno della concorrenza non perché si porta una vera innovazione. Se delphi 1 fosse stato come XE2 adesso non avremmo XE2 e non avremmo avuto neanche Delphi 2.
Sarò un po’ all’antica ma sono certo che il vero valore aggiunto in uno sviluppo software non sia il linguaggio ma la testa del programmatore che sta dinnanzi al monitor… In realtà il valore aggiunto in qualche cosa è sempre la persona (da molti anni leggo le notizie online, avete notato anche voi quanti errori si vedono nei vari siti delle testate più prestigiose?).

La prossima volta vi esporrò i risultati dei miei test cross platform :)

Ricordo che durante la conferenza il nome firemonkey è stato legato all’oroscopo cinese, l’anno della scimmia sarà il 2016, spero di non dover aspettare così tanto per un prodotto stabile :(

Iscriviti

Ricevi al tuo indirizzo email tutti i nuovi post del sito.

Unisciti agli altri 63 follower