FAQ DelphiConsultez toutes les FAQ

1
2
3
4
5
procedure TObject.Free;  
begin  
  if Self <> nil then  
    Destroy;  
end;

1
2
3
with TPaintBox(Sender).Canvas.Brush do  
  begin  
    Color := Self.Color;

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
unit UnitSomme;  
  
interface  
  
type  
  TSomme = class  
   private  
     FA,FB: Integer;  
     FResultat: Integer;  
     procedure SetA(const Value: Integer);  
     procedure SetB(const Value: Integer);  
   protected  
     // La fonction que l'on souhaiterais utiliser...  
     function Somme(A,B:Integer):Integer;  
   public  
     constructor Create;  
     destructor Destroy;  
     property A:Integer read FA write SetA;  
     property B:Integer read FB write SetB;  
     property Resultat:Integer read FResultat;  
  end;  
...  
implementation  
...  
function TSomme.Somme(A,B:Integer):Integer;  
begin  
  result:=A+B;  
end;  
  
...  
end.

1
2
3
4
5
6
var MaSomme:TSomme;  
  ...  
  MaSomme.A:=5;  
  MaSomme.B:=9;  
  Result:=MaSomme.Resultat;  //  
  ...

TPublicFactorielle(MaFactorielle)

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
unit Unit1;  
  
interface  
  
uses  
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, unitFactorielle;  
  
type  
  //Notre classe dérivée...  
  //A travers sa définitions, toutes les méthodes protégées deviennent  
  //visibles pour tout le code écrit dans notre unité unit1  
  TPublicSomme=class(TSomme);  
  
  TForm1 = class(TForm)  
  private  
    { Déclarations privées }  
  public  
    { Déclarations publiques }  
    procedure Calcule;  
  end;  
...  
implementation  
...  
procedure TForm1.Calcule;  
var MaSOmme:TSomme;  
begin  
...  
  //On transtype MaSomme afin d'utiliser la méthode rendu visible  
  Result:=TPublicSomme(MaSomme).Somme(A,B);  
....  
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
type  
TMenuItemPublic=class(TComponent)  
  public  
    FCaption: string;  
    FHandle: HMENU;  
    FChecked: Boolean;  
    FEnabled: Boolean;  
    FDefault: Boolean;  
    FAutoHotkeys: TMenuItemAutoFlag;  
    FAutoLineReduction: TMenuItemAutoFlag;  
    FRadioItem: Boolean;  
    FVisible: Boolean;  
    FGroupIndex: Byte;  
    FImageIndex: TImageIndex;  
    FActionLink: TMenuActionLink;  
    FBreak: TMenuBreak;  
    FBitmap: TBitmap;  
    FCommand: Word;  
    FHelpContext: THelpContext;  
    FHint: string;  
    FItems: TList;  
    FShortCut: TShortCut;  
    FParent: TMenuItem;  
    FMerged: TMenuItem;  
    FMergedWith: TMenuItem;  
    FMenu: TMenu;  
    FStreamedRebuild: Boolean;  
    FImageChangeLink: TChangeLink;  
    FSubMenuImages: TCustomImageList;  
    FOnChange: TMenuChangeEvent;  
    FOnClick: TNotifyEvent;  
    FOnDrawItem: TMenuDrawItemEvent;  
    FOnAdvancedDrawItem: TAdvancedMenuDrawItemEvent;  
    FOnMeasureItem: TMenuMeasureItemEvent;  
    FAutoCheck: Boolean;  
  end;

1
2
3
4
5
6
var UnMenuItem:TMenuItem;  
begin  
....  
  TMenuItemPublic(UnMenuItem).FImageIndex:=NewIndex;  
....  
end;

1
2
3
4
5
6
7
8
9
10
11
Var MonObjet : TUneClasse; 
    ParametreUn : String; 
  
begin 
 Try 
    MonObjet:=TUneClasse.Create(ParametreUn); 
    ...Traitement... 
  Finally 
    FreeAndNil(MonObjet); 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
Var MonObjet : TUneClasse; 
    ParametreUn : String; 
  
begin 
 Try 
   MonObjet:=Nil; 
   MonObjet:=TUneClasse.Create(ParametreUn); 
   ...Traitement... 
  finally 
   FreeAndNil(MonObjet); 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
Class procedure TUneClasse.CreateAndNilIfExcept(Var AObjet:TUneClasse; ParametreUn:String); 
begin 
 try 
  AObjet:=TUneClasse.Create(ParametreUn); 
 except 
  On Exception do 
   begin 
    AObjet:=Nil; //Evite la violation d'accés 
    Raise;        // On redéclenche l'exception 
   end; 
 end; 
end;

1
2
3
4
5
6
7
8
9
10
11
Var MonObjet : TUneClasse; 
    ParametreUn : String; 
  
begin 
 Try 
   TUneClasse.CreateAndNilIfExcept(MonObjet,ParametreUn); 
   ...Traitement... 
  finally 
   FreeAndNil(MonObjet); 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
procedure TForm1.UneActionADeterminer(Parametre:integer); 
begin 
  ... 
  case Parametre of 
      0:MaProcedure0; 
      1:MaProcedure1; 
      2:MaProcedure2; 
      3:MaProcedure3; 
      4:MaProcedure4; 
      5:MaProcedure5; 
      ..... 
      203:MaProcedure203; 
      //etc... 
  end; 
  ... 
end;

1
2
3
4
5
6
procedure TForm1.UneActionADeterminer(Parametre:integer); 
begin 
  ... 
  MesProcedures[Parametre];       
  ... 
end;

<Nom du Type> = <procedure ou function>[(<paramètres>)[:<type de resultat>]] [of object;]

1
2
type 
  TProcedureAvecParametres=procedure(a,b:integer;s:string) of object;

1
2
type 
  TProcedureSimple=procedure of object;

1
2
type 
  TOperationArithmetique=function(a,b:real):real of object;

1
2
type 
  TTraiterUnCodeErreur=function:boolean of object;

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
type 
  
TOperationArithmetique=function(a,b:real):real of object; 
  
TForm1 = class(TForm) 
    ... 
  private 
    { Déclarations privées } 
  public 
    { Déclarations publiques } 
    ... 
    TableauDeFonctions:array[0..3] of TOperationArithmetique; 
    function Addition(a,b:real):real; 
    function Multiplication(a,b:real):real; 
    function Division(a,b:real):real; 
    function Soustraction(a,b:real):real; 
    ... 
  end; 
... 
implementation 
... 
function TForm1.Addition(a,b:real):real; 
begin 
  result:=a+b; 
end; 
  
function TForm1.Multiplication(a,b:real):real; 
begin 
  result:=a*b; 
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
type 
  
TOperationArithmetique=function(a,b:real):real; 
  
TForm1 = class(TForm) 
    ... 
  private 
    { Déclarations privées } 
  public 
    { Déclarations publiques } 
    ... 
    TableauDeFonctions:array[0..3] of TOperationArithmetique; 
    ... 
  end; 
  
function Addition(a,b:real):real; 
function Multiplication(a,b:real):real; 
function Division(a,b:real):real; 
function Soustraction(a,b:real):real; 
... 
implementation 
... 
function Addition(a,b:real):real; 
begin 
  result:=a+b; 
end; 
  
function Multiplication(a,b:real):real; 
begin 
  result:=a*b; 
end;

1
2
3
4
5
6
7
procedure TForm1.InitialisationDuTableau 
begin 
  TableauDeFonctions[0]:=Addition; 
  TableauDeFonctions[1]:=Multiplication; 
  ... 
  //etc. 
end;

1
2
3
4
5
6
7
8
9
procedure TForm1.UneActionADeterminer(Parametre:integer); 
begin 
  //si Parametre est compris entre la borne inférieure et la borne supérieure du tableau de procédures 
  if ((Parametre>=low(TableauDeProcedures)) and (Parametre<=high(TableauDeProcedures)) then 
  //si l'entrée du tableau contient effectivement quelque chose (une procédure) 
  if Assigned(TableauDeProcedures[Parametre]) then 
  //exécution de la procédure ad hoc 
  TableauDeProcedures[Parametre]; 
end;

1
2
3
4
5
6
procedure TForm1.Calcule(OperationChoisie:integer;NombreA,NombreB:real;var resultat:real); 
begin 
   if ((OperationChoisie>=0) and (OperationChoisie<=3)) then 
   if Assigned(TableauDeFonctions[OperationChoisie]) then 
   resultat:=TableauDeFonctions[OperationChoisie](NombreA,NombreB); 
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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
unit Unit1; 
  
interface 
  
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls; 
type 
  //Définition d'un type de procedure simple 
  TProcedureAffichage=procedure of object; 
  
  TForm1 = class(TForm) 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
  private 
    { Déclarations privées } 
  public 
    { Déclarations publiques } 
    TableauDeProcedures:array[0..2] of TProcedureAffichage; 
    procedure AffichageShowMessage; 
    procedure AffichageDansLaFiche; 
    procedure AffichageBarreDeTitre; 
  end; 
  
var 
  Form1: TForm1; 
  
implementation 
  
{$R *.dfm} 
  
{ TForm1 } 
  
procedure TForm1.AffichageShowMessage; 
begin 
  showmessage('Procedure n°1'); 
end; 
  
procedure TForm1.AffichageDansLaFiche; 
begin 
  canvas.font.Color:=random($ffffff); 
  canvas.TextOut(10,10,'Procédure n°2'); 
end; 
  
procedure TForm1.AffichageBarreDeTitre; 
var i:integer; 
    oldcaption:string; 
begin 
  oldcaption:=Caption; 
  for i:=0 to 9 do 
  begin 
    caption:='Procedure n°3'; 
    sleep(200); 
    caption:=''; 
    sleep(100); 
  end; 
  caption:=oldcaption; 
end; 
  
//Événement OnClick du Bouton 
procedure TForm1.Button1Click(Sender: TObject); 
var i:integer; 
begin 
  //choix aléatoire d'une procedure d'affichage 
  i:=Random(3); 
  if assigned(TableauDeProcedures<i>) then 
  TableauDeProcedures<i>; 
end; 
  
//Événement OnCreate de la fiche 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Randomize; 
  TableauDeProcedures[0]:=AffichageShowMessage; 
  TableauDeProcedures[1]:=AffichageDansLaFiche; 
  TableauDeProcedures[2]:=AffichageBarreDeTitre; 
end; 
  
end.

function printf(Format: PChar): Integer; cdecl; varargs;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
//Programme de type Console 
uses Typinfo; 
  
var DonneeDeType : PTypeData; 
  
begin 
  //Récupére les information de RTTI d'une interface  
 DonneeDeType := GetTypeData(typeinfo(ISWbemObject)); 
  
  //Vérifie si l'interface posséde bien un GUID 
 if ifHasGuid in DonneeDeType^.IntfFlags then 
   Writeln(GUIDToString(DonneeDeType^.Guid)); 
  
 Writeln(DonneeDeType^.IntfUnit); // Nom de l'unité où est déclarée l'interface 
 readln; 
end.

1
2
3
4
5
6
7
procedure VideBufferClavier; 
var 
  Msg: TMsg; 
begin 
  while PeekMessage(Msg, 0, WM_KEYFIRST, WM_KEYLAST, 
    PM_REMOVE or PM_NOYIELD) do; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
function card(var UneVariable; size: integer): integer; 
const // table des bits actifs dans un groupe de 4 bits (exemple : 9=8+1-->2 bits) 
  NBits: array[0..15] of integer=( 0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4); 
var 
  t: TbyteArray absolute UneVariable;  //table pointant sur le premier octet de la variable 
                                        //dont on souhaite connaître le nombre de 
                                        //bits allumés 
  j: integer; 
  PoidsFort:byte; 
  PoidsFaible:byte; 
begin 
  result:=0; 
  //Pour chaque octet du tableau 
  for j := 0 to size - 1 do 
  begin 
    //chaque octet est coupé en deux groupe de 4 bits 
    PoidsFort:=t[j] shr 4 
    PoidsFaible:=t[j] and $F; 
    //On dénombre pour chaque groupe de 4 bits le nombre de bits allumés 
    inc(result, NBits[PoidsFort] and $F] + NBits[PoidsFaible]); 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
var MonEnsemble:Set of Byte; 
     NomBreDElements:integer; 
begin 
... 
  MonEnsemble:=[128,25,96,36,200]; 
  
  //on passse à notre fonction notre variable  
  //et aussi sa taille en octets, obtenue grace à la fonction SizeOf() ) 
  NomBreDElements:=Card(MonEnsemble,SizeOf(MonEnsemble)); 
  
  ShowMessage(IntToStr(NomBreDElements)); //affiche "5" 
... 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
var  UnEntier:integer; 
      UnBoolean:Boolean; 
      UnReel:double; 
      UneClasse:TForm; 
      UneChaine:string; 
      UnTableau:array[] of ... //QuelqueChose  
begin 
    ... 
   NomBreDElements:=Card(UnEntier,SizeOf(UnEntier)); 
   NomBreDElements:=Card(UnBoolean,SizeOf(UnBoolean)); 
   NomBreDElements:=Card(UnReel,SizeOf(UnReel)); 
   NomBreDElements:=Card(UneClasse,SizeOf(UneClasse)); 
   NomBreDElements:=Card(UneChaine,SizeOf(UneChaine));     
   NomBreDElements:=Card(UnTableau:,SizeOf(UnTableau));  
   ... 
end;

1
2
3
4
5
6
7
8
function CreateGuid: string; 
var 
  GUID: TGUID; 
begin 
  Result := ''; 
  if CoCreateGuid(GUID) = S_OK then 
    Result := GUIDToString(GUID); 
end;

function CreateClassID: string;

function CreateGUID(out Guid: TGUID): HResult;

function IfThen (AValue : Boolean; const ATrue : Integer; const AFalse : Integer = 0) : Integer; overload;

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
Interface 
  
{ Immediate If } 
{ IIF renvoyant un entier } 
function IIF(ACondition: boolean; ATruePart, AFalsePart: integer): integer; overload; 
{ IIF renvoyant un extended } 
function IIF(ACondition: boolean; ATruePart, AFalsePart: Extended): Extended; overload; 
{ IIF renvoyant une string } 
function IIF(ACondition: boolean; ATruePart, AFalsePart: string): string; overload; 
{ IIF renvoyant un objet } 
function IIF(ACondition: boolean; ATruePart, AFalsePart: TObject): TObject; overload; 
  
Implementation 
function IIF(ACondition: boolean; ATruePart, AFalsePart: integer): integer; 
{ Immediate IF pour les entiers } 
begin 
  if ACondition then 
    Result := ATruePart else 
      Result := AFalsePart; 
end; 
  
function IIF(ACondition: boolean; ATruePart, AFalsePart: Extended): Extended; 
{ Immediate IF pour les flottant } 
begin 
  if ACondition then 
    Result := ATruePart else 
      Result := AFalsePart; 
end; 
  
function IIF(ACondition: boolean; ATruePart, AFalsePart: string): string; 
{ Immediate IF pour les chaînes } 
begin 
  if ACondition then 
    Result := ATruePart else 
      Result := AFalsePart; 
end;

1
2
3
4
5
6
7
function IIF(ACondition: boolean; ATruePart, AFalsePart: TObject): TObject; 
{ Immediate IF pour les objets } 
begin 
  if ACondition then 
    Result := ATruePart else 
      Result := AFalsePart; 
end;

1
2
3
4
5
6
7
8
procedure TMyObject.TestIIF; 
var 
  idx: integer; 
  MyString: String; 
begin 
  idx := 10; { Par exemple } 
  MyString := IIF(idx=0,'Zero','Différent de Zero'); 
end;

1
2
3
4
5
6
7
8
9
10
procedure TMyObject.TestIIF; 
var 
  idx: integer; 
  MyString: String; 
begin 
  idx := 10; { Par exemple } 
  if idx=0 then 
    MyString = 'Zero' else 
      MyString = 'Différent de Zéro'; 
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
procedure TForm2.Button1Click(Sender: TObject); 
var 
   eLatitude1, eLatitude2   : Extended; 
   eLongitude1, eLongitude2 : Extended; 
   rLatitude1, rLatitude2   : Extended; 
   rTheta                   : Extended; 
   eDistance                : Extended; 
begin 
   // coordonnées GPS de la ville de Dijon (21000) 
   eLatitude1  := 47.366667; 
   eLongitude1 := 5.033333; 
  
   // coordonnées GPS de la ville d'Aubagne (13400) 
   eLatitude2  := 43.283333; 
   eLongitude2 := 5.566667; 
  
   // conversion des degrés en radians 
   rLatitude1  := DegToRad(eLatitude1); 
   rLatitude2  := DegToRad(eLatitude2); 
  
   // différence entre les deux longitudes 
   rTheta      := DegToRad(eLongitude1 - eLongitude2); 
  
   // trigonométrie circulaire 
   eDistance   := Sin(rLatitude1) * Sin(rLatitude2) + Cos(rLatitude1) * Cos(rLatitude2) * Cos(rTheta); 
   eDistance   := ArcCos(eDistance); 
   eDistance   := eDistance * 180 / Pi; 
   // 60 minutes par degré, et passage de mile en mile nautique 
   eDistance   := eDistance * 60 * 1.1515; 
  
   // passage des miles en kilomètres 
   eDistance   := eDistance * 1.609344; 
  
   // affichage de la valeur 
   ShowMessage(eDistance.ToString); 
end;