FAQ DelphiConsultez toutes les FAQ

IntToHex(Cardinal(@MonObjet),6);

var UnNombre: Cardinal;

1
2
3
4
5
6
7
var UneAdresse: Pointer;  
      UnNombre: Cardinal;  
begin  
  UneAdresse := @UnNombre;  
  //ou bien  
  UneAdresse := Addr(UnNombre);  
end;

1
2
3
4
5
6
7
  
Type  
  TSuperVariable = Record  
    Case b: Boolean of  
    True: (UnByte: Byte);  
    False: (UneChar: Char);  
  end;

1
2
3
4
5
6
7
8
9
10
11
var  
  SuperVariable: TSuperVariable  
  UnMessage: String;  
begin  
  SuperVariable.AByte := 65;  
  //est équivalent à  
  //SuperVariable.AChar := 'A';  
  
  UnMessage := 'Valeur de AByte au format caractère : ' + SuperVariable.AChar);  
  ShowMessage(UnMessage);  
end;

1
2
3
4
5
6
7
8
9
Type  
  TSuperVariable1 = Record  
    Case i: SmallInt of  
      1: (UnPetitReel: Single);  
      2: (UnEntierSigne: Integer);  
      3: (UnEntierNonSigne: Cardinal);  
      4: (UnPointeur: Pointer);  
      5: (UnPointeurSurUnEntier: ^Integer);  
  end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Type  
  TAccesMemoire = Record  
    Case i: Smallint of  
      1: (UnPointeur: Pointer);  
      2: (UneAdresse: Cardinal);  
      3: (UnPointeurSurCaractere: ^Char);  
      4: (UnPointeurSurByte: ^Byte);  
  end;  
  
var Acces: TAccesMemoire;  
    UneChaine: String;  
    i: Integer;  
    UnMessageBizarre: String;  
begin  
  //Initialisation des données  
  UneChaine := 'bonjour les Delphinautes, comment ça va ? :)';  
  i := 66;  
  UnMessageBizarre := '';  
  
  //on se place, sur le premier caractère de la chaîne :  
  Acces.UnPointeurSurCharactère := @UneChaine[1];  
  
  //on remplace le b minuscule par l'équivalent ASCII de ce qu'il y a dans i;  
  Acces.UnPointeurSurByte^ := i;  
  
  //Affichage  
  ShowMessage(UneChaine);  
  
  //deux pas en avant, un pas en arrière… (5 fois)   
  for i := 1 to 5 do  
  begin  
    //2 pas en avant  
    Acces.UneAdresse := Acces.UneAdresse + 2;  
    //on récupère le caractère pointé  
    UnMessageBizarre := UnMessageBizarre + Acces.UnPointeurSurCaractere^;  
    //1 pas en arrière  
    Acces.UneAdresse := Acces.UneAdresse-1;  
    //on récupère le caractère pointé  
    UnMessageBizarre := UnMessageBizarre + Acces.UnPointeurSurCaractere^;  
  end;  
  
  ShowMessage(UnMessageBizarre);  
  
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
procedure TForm1.Button1Click(Sender: TObject); 
var 
  LArray: array of HWND; 
  I: Integer; 
begin 
  SetLength(LArray, 0); 
  for I := 0 to Pred(ComponentCount) do 
    if Components[I] is TWinControl then 
    begin 
      SetLength(LArray, Length(LArray) + 1); 
      LArray[Length(LArray) + 1] := TWinControl(Components[I]).Handle; 
    end; 
end;

1
2
SetLength(LArray, Length(LArray) + 1); 
      LArray[Length(LArray) + 1] := TWinControl(Components[I]).Handle;

1
2
3
4
L := MyList.Count() ; 
SetLength(LArray, L) ; 
For I := 0 to Pred(L) do 
  LArray[I] := ...

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
procedure TForm1.Button1Click(Sender: TObject); 
var 
  LArray: array of HWND; 
  I, J: Integer; 
begin 
  J := 0; 
  SetLength(LArray, ComponentCount); 
  for I := 0 to Pred(ComponentCount) do 
    if Components[I] is TWinControl then 
    begin 
      LArray[I] := TWinControl(Components[I]).Handle; 
      Inc(J); 
    end; 
  SetLength(LArray, J); 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
procedure TFoo.Bar 
const 
  cstGrowBy: Integer = 100; 
var 
  LList: array of Int64; 
  I, J: Integer; 
begin 
  SetLength(LList, 0); 
  I := 0; 
  AcquireDriver; 
  try 
    SetSQL('SELECT ID FROM ...); //Requête SQL donnant un nombre N de résultats             
    ExecSelect; 
    while not QueryEOF do //Notre boucle 
    try 
      //Motif d'allocation évoqué dans le paragraphe ci dessus 
      if (I + 1 > Length(LList)) then //Si le nombre actuel d'éléments atteint la taille actuelle 
        SetLength(LList, Length(LList) + cstGrowBy); //On alloue un nouveau bloc 
      LList[I] := GetFieldAsInt64('ID'); //On affecte une valeur au tableau 
    finally 
      Inc(I); 
      QueryNext; 
    end; 
SetLength(LList, I) ; 
//On peut exploiter le tableau...

1
2
3
4
with TMOnObjet.Create do  
begin  
  
end;

1
2
3
4
5
Type  
  GetterClassHelper=Class Helper For TObject  
    Function WriteClassName:ShortString;  
    Function  GetInstance:TObject;  
  end;

1
2
3
4
5
6
7
8
begin  
 With TStringList.Create do  
  begin  
   ...  
   Traitement(GetInstance); // récupére une référence sur l'instance  
   ...  
  end;  
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
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  
  With TTest.Create do  
  Try  
   Nom:='Je reference l''instance transitoire dans le bloc With-do';  
   visualise(GetInstance,' ici elle n''a pas de nom');  
  Finally  
   Free;  
  end;   
 Readln; 
end.

1
2
3
4
5
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');  
  end;

ClasseEnfant := ClasseParent as TClasseEnfant;

1
2
3
4
if ClasseParent is TClasseEnfant then 
  ClasseEnfant := TClasseEnfant(ClasseParent) 
else 
  EInvalidCast.Create(ClasseParent.ClassName + ' n''est pas un descendant de '+TClasseEnfant.ClassName);

UneInterface := UneAutreInterface as IUneInterface;

1
2
if UneAutreInterface.QueryInterface(GUID_de_IUneInterface, UneInterface) <> 0 then 
  raise EIntfCastError.Create('La référence n''implémente pas l'interface demandée');

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
type 
  TGenericPoint<T> = record 
  public 
    X, Y : T; 
  public 
    function _Size: integer; // renvois la taille du type T 
    function _Info: pTypeInfo; // renvois les infos du type T 
    function _Data: pTypeData; // renvois les infos de la données du type T 
    function _Name: string; // renvois le nom du type T 
    procedure _Zero; // mets à zéro X et Y peu importe le type de T 
  end; 
  
  TSmallPoint = TGenericPoint<SmallInt>; 
  TPoint = TGenericPoint<Integer>;  
  TPointF = TGenericPoint<Single>; 
  TBigPoint = TGenericPoint<Int64>; 
  TBigPointF =  TGenericPoint<Double>;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
function TGenericPoint<T>._Name: string; 
begin 
  result := GetTypeName(TypeInfo(T)); 
end; 
  
function TGenericPoint<T>._Size: integer; 
begin 
  result := SizeOf(T) shl 1; 
end; 
  
function TGenericPoint<T>._Info: pTypeInfo; 
begin 
  result := pTypeInfo(TypeInfo(T)); 
end; 
  
function TGenericPoint<T>._Data: pTypeData; 
begin 
  result := pTypeData(GetTypeData(_Info)); 
end; 
  
procedure TGenericPoint<T>._Zero; 
begin 
  X := Default(T); 
  Y := Default(T); 
end;