Les possibles évolutions du langage Delphi 2006

Type 

  GetterClassHelper=Class Helper For TObject 
    Function  GetInstance:TObject; 
  end; 

   function GetterClassHelper.GetInstance:TObject;
   begin
     // Self fait référence à la variable en cours,
     // et non à une possible instance de type GetterClassHelper.
    Result:=Self;
   end;

begin 
 With TMonObjet.Create do 
  begin 
   ... 
   Traitement(GetInstance); // Récupére la référence 
   ... 
  end; 
end.

program classhelper;

{$APPTYPE CONSOLE} 

uses
  SysUtils;

Type
  TTest=Class
   Nom: String;
  end;

  GetterClassHelper=Class Helper FOR TObject
    Function WriteClassName:ShortString;
    Function  GetInstance:TObject;
  end;

  Function GetterClassHelper.WriteClassName:ShortString;
   begin
      // Self fait référence au type Test, et non à GetterClassHelper.
     Result:=Self.ClassName;
   end;

   function GetterClassHelper.GetInstance:TObject;
   begin
     // Self fait référence à la variable en cours,
     // et non à une possible instance de type GetterClassHelper.
    Result:=Self;
   end;

Procedure Visualise(AInstance :TObject; NomVaraible:String);
begin
 Writeln('Nom de la variable : ',NomVaraible);
 Writeln;
 Writeln('Instance de la classe '+ TTest(AInstance).WriteClassName+' dans la methode visualise : '+TTest(AInstance).Nom);
 Writeln;
end;

Var Premier, Second : TTest;

begin
 Premier:=TTest.Create;
 Premier.Nom:='Je reference l''instance Premier';
 visualise(Premier,'Premier');

  // Teste si on récupère bien une référence sur l'instance Premier
  // équivaut à :
  //  Second:=Premier
 Second:=TTest(Premier.GetInstance);
 visualise(Second,'Second');
 Readln;

 Premier.Free;
 Second:=Nil;

  // Objectif final sur une classe personnelle
 With TTest.Create do
  begin
   Nom:='Je reference l''instance transitoire dans le bloc With-do';
   visualise(GetInstance,' ici elle n''a pas de nom');
   Free;
  end;
 Readln;

  // Objectif final sur une classe de la VCL
 With TStringList.Create do
  begin
   visualise(GetInstance,' ici elle n''a pas de nom');
   Free;
  end;
 Readln; 
end.

With TTest.Create do 
  begin 
   Nom:='Je reference l''instance transitoire dans le bloc With-do'; 
   visualise(self,' Dans notre cas self n''existe pas'); 
   Free;
  end;

TDescellee= class Helper For TSealedClass
   class var unChampDeClass : integer ;
   procedure FaitqqChose;
   Class procedure Affiche;
   Constructor Create;
 end;

En plus des types record traditionnels, Delphi autorise des types record plus complexe et plus proche d'une 
classe.
En plus des champs, les records peuvent avoir des propriétés et des méthodes (y compris des constructeurs),
 des propriétés de classe, des méthodes de classe, des champs de classe, et des types imbriqués. 

Voici une définition d'un type record simple avec certaines fonctionnalités de classes.
(note : le texte d'origine utilise l'expression anglaise 'class-like')

type
  TMyRecord = record
    type
      TInnerColorType = Integer;
    var
      Red: Integer;
    
    class var Blue: Integer;
    
    procedure printRed();
    constructor Create(val: Integer);
    
    property RedProperty: TInnerColorType read Red write Red;
    
    class property BlueProp: TInnerColorType read Blue write Blue;
end;

constructor TMyRecord.Create(val: Integer);
begin
  Red := val;
end;

procedure TMyRecord.printRed;
begin
  writeln('Red: ', Red);
end;

Cependant les records peuvent maintenant partager une grande partie des fonctionnalités des classes, 
il y a quelques différences importantes entre les classes et les records.

- Les records ne supportent pas l'héritage.

- Les records peuvent contenir des parties variables, les classes ne le peuvent pas.

- Les records sont des types valeur, ainsi ils sont copiés lors d'affectation, passés par valeur, 
et alloués sur la pile à moins qu'ils soient déclarés globalement ou explicitement alloués en utilisant
les fonctions New et Dispose. Les classes sont des types référence, elles ne sont donc pas copiées lors 
d'une affectation, elles sont passées par référence, et elles sont allouées sur le tas (Heap).

- Les records permettent la surcharge d'opérateurs sur les plateformes Win32 et .NET; Les classes permettent la 
surcharge d'opérateurs seulement sous .NET. 

- Les records sont construits automatiquement, en utilisant un constructeur par défaut qui est sans argument, 
mais les classes doivent être explicitement construites. 
Puisque les records ont un constructeur par défaut, n'importe quel constructeur de record défini par 
l'utilisateur doit avoir obligatoirement un ou plusieurs paramètres.

- Les types record ne peuvent pas avoir de destructeurs. 

- Les méthodes virtuelles (celles indiquées avec les mots clés virtual, dynamic, et message) ne peuvent pas être 
employées dans les types record. 

- À la différence des classes, les types record sur la plateforme Win32 ne peuvent pas implémenter d'interfaces;
Cependant les records sur la plateforme .NET le peuvent.

   y := x + x;   // Appelle TMaClasse.Add(a, b: TMaClasse): TMaClasse
   y := x add x ; // Interdit !
   y := TMaClasse.add(x, x); // Interdit !

  A,Z : integer
Begin
   A:= Z+TMaClasse(x);

type
  typeName = [record]
      class operator Signature_de_déclaration (a: type): Type_résultant;
      liste d'opérateur    
  end;

class operator Name._de_type. Signature _de_déclaration (a: type): Type_résultant;

unit UTDBBool;

interface

type

   TDBBool = record
   Strict private
        // Champ privé pour stocker la valeur du type
      FValeur : integer;

        // champs de classe
      Class var FdbFalse : TDBBool;
      Class var FdbNull  : TDBBool;
      Class var FdbTrue  : TDBBool;

         // Type interne et Privé
        type
           DBType = -1..1;  // Etendue du type

     Private
      // Le constructeur ne doit pas être accessible
      // Private pour TDBBool.dbTrue:=TDBBool.Create(0);
      Constructor Create(AValeur: DBType);
        // Constantes internes et Privées
      const
        // Valeurs du type autorisé
        // On ne reprend pas à l'identique les valeurs du type Boolean de Delphi
        // Le zéro permet les tests x>0 pour true et x<0 pour false, voir aussi l'opérateur LogicalNot
       cdbNull   : integer =0;
       cdbFalse  : Integer =-1;
       cdbTrue   : Integer =1;

      Class procedure Init;Static;
     Public
       // Examine la valeur d'un DBBool.
       // Renvoie true si la valeur de Fvaleur correspond à la valeur testée
      Function IsNull  : Boolean;
      Function IsFalse : Boolean;
      Function IsTrue  : Boolean;

        // Surcharge d'opérateur
      Class operator Implicit(Avalue: Boolean): TDBBool;
      Class operator Implicit(x: TDBBool): String;
      Class operator Explicit(x: TDBBool): Boolean;
      Class operator Equal(x,y : TDBBool):TDBBool; //  =
      Class operator NotEqual(x,y : TDBBool):TDBBool; // <>
      Class operator LogicalNot(x : TDBBool):TDBBool; // not
      Class operator LogicalAnd(x,y : TDBBool):TDBBool; // and
      Class operator LogicalOr(x,y : TDBBool):TDBBool; // or

        // Convertit la valeur spécifiée en sa représentation String équivalente.
      Function ToString: String;
       // Propriétées en ReadOnly
      Class Property dbFalse : TDBBool Read FdbFalse;
      Class Property dbNull  : TDBBool Read FdbNull;
      Class Property dbTrue  : TDBBool Read FdbTrue;
    end;

implementation

uses Classes;

   Constructor TDBBool.Create(AValeur: DBType);
   Begin
    FValeur:=AValeur;
   end;

   Class Procedure TDBBool.Init;
   Begin
    TDBBool.FdbNull.FValeur:=cdbNull;
    TDBBool.FdbFalse.FValeur:=cdbFalse;
    TDBBool.FdbTrue.FValeur:=cdbTrue;
   end;

   Function TDBBool.IsNull  : Boolean;
   begin
    Result:=(Fvaleur=cdbNull);
   end;

   Function TDBBool.IsFalse : Boolean;
   begin
    Result:=(Fvaleur=cdbFalse);
   end;

   Function TDBBool.IsTrue  : Boolean;
   begin
    Result:=(Fvaleur=cdbTrue);
   end;

   //  implémentation des Opérateurs

    // Conversion implicite de boolean vers TDBBool.
    // renvoie DBBool.FdbTrue pour true
    // et DBBool.FdbFalse pour false
   Class operator TDBBool.Implicit(Avalue: Boolean): TDBBool;
   begin
    If Avalue=True
     then Result:=FdbTrue
     else Result:=FdbFalse;
   end;


    // Conversion explicite de TDBBool vers boolean.
    // Déclenche une exception si x est égal à cdbNull,
    // sinon renvoie True ou False.
   Class operator TDBBool.Explicit(x: TDBBool): Boolean;
   begin
    If x.FValeur=cdbNull
     then raise EInvalidOperation.Create('TDBOOL:opération invalide')
     else Result:= x.FValeur>cdbNull // x.FValeur=cdbTrue;
   end;

    // Opérateur d'égalité. Renvoi FdbNull si l'un des opérandes est égal à cdbNull,
    // sinon renvoie FdbTrue ou FdbFalse:
   Class operator TDBBool.Equal(x : TDBBool; y : TDBBool):TDBBool;
    // ATTENTION : pas d'évaluation booléenne complète, cf C#
   begin
     if ((x.FValeur = cdbNull) or (y.FValeur =cdbNull))
      then result:=FdbNull
      else if x.FValeur = y.FValeur
            then Result:=FdbTrue
            else Result:=FdbFalse;
   end;

    // Opérateur d'inégalité. Renvoie FdbNull si l'un des opérandes est égal à FdbNull,
    // sinon renvoie FdbTrue ou FdbFalse:
   Class operator TDBBool.NotEqual(x,y : TDBBool):TDBBool;
    // ATTENTION : pas d'évaluation booléenne complète, cf C#
   Begin
     if ((x.FValeur = cdbNull) or (y.FValeur =cdbNull))
      then result:=FdbNull
      else if x.FValeur <> y.FValeur
            then Result:=FdbTrue
            else Result:=FdbFalse;
   end;

    // Opérateur de négation logique. Renvoie  :
    //  FdbTrue si l'opérande est égale à FdbFalse
    //  FdbNull si l'opérande est égale à FdbNull,
    //  ou FdbFalse si l'opérande est égale à FdbTrue.
   Class operator TDBBool.LogicalNot(x : TDBBool):TDBBool;
   begin
      Result:=TDBBool.Create(-x.FValeur);
   end;

    // Opérateur ET ( AND ) logique. Renvoie
    //  FdbFalse si l'un des opérandes est égal à FdbFalse,
    //  FdbNull si l'un des opérandes est égal à FdbNull,
    //  sinon renvoie FdbTrue.
   Class operator TDBBool.LogicalAnd(x,y : TDBBool):TDBBool;
   var Resultat:Integer;
   begin
     If x.FValeur < y.FValeur
      then Resultat:=x.FValeur
      else Resultat:=y.FValeur;
     Result:=TDBBool.Create(Resultat);
   end;

    // Opérateur ET ( AND ) logique. Renvoie
    //  FdbTrue si l'un des opérandes est égal à FdbTrue,
    //  FdbNull si l'un des opérandes est égal à FdbNull,
    //  sinon renvoie FdbFalse.
   Class operator TDBBool.LogicalOr(x,y : TDBBool):TDBBool;
   var Resultat:Integer;
   begin
     If x.FValeur > y.FValeur
      then Resultat:=x.FValeur
      else Resultat:=y.FValeur;
     Result:=TDBBool.Create(Resultat);
   end;

    // Conversion implicite de TDBBool vers String.
   Class operator TDBBool.Implicit(x: TDBBool): String;
   begin
      If x.Fvaleur > 0
       then Result:='dbTrue'
       else If x.Fvaleur < 0
             then Result:='dbFalse'
             else Result:='dbNull';
   end;

    // Surcharge la méthode ToString pour convertir un TDBBool vers une String.
   Function TDBBool.ToString: String;
   begin
      Case Fvaleur of
        -1: Result:='TDBBool.False';
         0: Result:='TDBBool.Null';
         1: Result:='TDBBool.True';
       else Raise EInvalidOperation.Create('TDBOOL:opération invalide');
      end;
   End;


 // Initialise les valeurs possibles du type
Initialization
 TDBBool.Init;
end.

    // Opérateur ET ( AND ) logique. Renvoie
    //  dbFalse si l'une des opérandes est égale à dbFalse,
    //  dbNull si l'un des opérandes est égal à dbNull,
    //  sinon renvoie dbTrue.
   Class operator TDBBool.LogicalAnd(x,y : TDBBool):TDBBool;
   var Resultat:Integer;
   begin
     If x.FValeur < y.FValeur
      then Resultat:=x.FValeur
      else Resultat:=y.FValeur;
     Result:=TDBBool.Create(Resultat);
   end;

program operateur;
{$APPTYPE CONSOLE}

uses
  SysUtils,
  UTDBBool in 'UTDBBool.pas',
  classes;

var
  a, b, c : TDBBool;

begin
  //Initialisation des variables hors constructeur
 a:=TDBBool.dbTrue; 
  // Assignation de la valeur de la variable a dans la variable b
 b:=a;              
 b:=TDBBool.dbNull;
 c:=TDBBool.dbFalse;

 WriteLn('a = ',a.ToString,' not a =', (not a).ToString); // Appel  : operator LogicalNot
 WriteLn('c =', c.ToString); // Appel  : operator LogicalOr
 WriteLn('b = ', b.ToString,' not b =', (not b).ToString);
 WriteLn('a and b =',(a and b).ToString); // Appel  : operator LogicalAnd
 WriteLn('a or b =', (a or b).ToString); // Appel  : operator LogicalOr

 Readln;
 
  // l'instruction case n'est pas possible sur un type record
 if b=TDBBool.dbTrue then
  Writeln('b est dbTrue')
 else
 if b=TDBBool.dbFalse then
  Writeln('b est dbFalse')
 else Writeln('b est dbNull');

  // a=c renvoi un résultat erroné 
  // if boolean(a=c) renvoi un résultat erroné 
 if boolean(a=c)=true
   then Writeln('A = C');

  //Valeur true ou false gérée
 try
  if boolean(a)=Boolean(c)  // Appel operator Explicit
   then Writeln('Boolean : a et c sont identiques')
   else Writeln('Boolean : a et c ne sont pas identiques');
 except
  On E:EInvalidOperation do
     WriteLn('a ou c est NULL')
 end;

  //Valeur Null non gérée, mais opération valide
 try
  if Boolean(b)=True
   then WriteLn('b est true definitivement')
   else WriteLn('b n''est definitivement pas true ');
 except
  On E:EInvalidOperation do
      WriteLn('b est NULL');
 end;

  //Valeur Null non gérée, mais opération valide
 try
  if boolean(a)=Boolean(b)
   then Writeln('a et b sont identiques')
   else Writeln('a et b ne sont pas identiques');
 except
  On E:EInvalidOperation do
     WriteLn('b est NULL')
 end;

 Readln;

(* Résultats attendus :
not DBBool.True = DBBool.False
not DBBool.Null = DBBool.Null
DBBool.True & DBBool.Null = DBBool.Null
DBBool.True or DBBool.Null = DBBool.True

a et c ne sont pas identique
b est NULL
b est NULL
*)
end.

program NouveauRecord2;
{$APPTYPE CONSOLE}

uses
  SysUtils;

type
 PMyRec=^MyRec;
 MyRec=Record
  A,B :byte;
  Constructor Create(lA,lB:byte);
  Procedure Ecrit(Name:String);
 end;

Constructor MyRec.Create(lA,lB:byte);
begin
 A:=lA;
 B:=lB;
end;

Procedure MyRec.Ecrit(Name:String);
begin
 Writeln(Name,' A=',A,' B=',B);
end;

procedure visu;
var T: MyRec;
begin
 // T n'est pas initialisé
 T.Ecrit('T locale');
end;

var Un : MyRec;
    R  : PMyRec;
begin
  //Variable globale initialisée à Zéro
 Un.Ecrit('UN');
 visu;

 New(R);                    //Alloue une zone mémoire
 R^.Create(1,2);            //Le constructeur réaffecte la même zone mémoire
 Un.Create(1,2);            //Le constructeur réaffecte la même zone mémoire
 Un:=MyRec.Create(10,16);   //L'assignation réaffecte la même zone mémoire
 Dispose(R);                //Désalloue la zone mémoire
 R:=Nil;
 R^.Ecrit('R après NIL.');  //Violation d'accès
end.

unit UMonObjet platform experimental;

{$DESCRIPTION 'text'}

{$D 'Mon Application version 12.5'}

{$E extension} ou {$EXTENSION extension}

$LIBPREFIX 'chaine'
 
 $LIBSUFFIX 'chaine'
 
 $LIBVERSION 'chaine'

//exemple 

 $LIBPREFIX 'lib' ou $LIBPREFIX 'bpl' 

 $LIBSUFFIX ' '
 
 $LIBVERSION ' '

{$LIBPREFIX ' '}

{$LIBSUFFIX '-2.1.3'}

{$LIBVERSION '-2.1.3'}

{$FINITEFLOAT ON}, {$FINITEFLOAT OFF}

{$METHODINFO ON} or {$METHODINFO OFF}

{$SetPEFlags <integer expression>} {$SetPEOptFlags <integer expression>}