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;

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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
unit UStateManager; 
  
interface 
  
uses System.SysUtils, System.Classes, System.StrUtils, System.Rtti, 
     Winapi.Windows, Vcl.Controls; 
  
type 
  
  TStateManager = class(TObject) 
  public 
    /// <summary> 
    ///   Permet de définir à l'avance le Owner sur lequel sera applliqué la traitement 
    /// </summary> 
    class var TheOwner: TWinControl; 
    /// <summary> 
    ///  Permet de modifier plusieurs TControls sur un objet visuel qui en contient plusieurs 
    /// </summary> 
    /// <param name="OwnerCtrls"> 
    ///   Composant qui contient les éléments à traiter 
    /// </param> 
    /// <param name="PropNames"> 
    ///  Les noms des propriétés à traiter 
    /// </param> 
    /// <param name="Values"> 
    ///   Les valeurs pour chaque propriété de PropNames 
    /// </param> 
    class procedure ChangeState(OwnerCtrls: TWinControl; PropNames: array of string; Values: array of const); 
  
    class procedure EnableCtrls(OwnerCtrls: TWinControl; State: Boolean; EnabledOrReaddOnly: Boolean = False); 
  end; 
  
implementation 
  
{ TStateManager } 
  
procedure AssignValue(Control: TControl; Prop: TRttiProperty; Valeur: TVarRec); 
begin 
  case Valeur.VType of 
    vtInteger: 
      Prop.SetValue(Control, Valeur.VInteger); 
    vtBoolean: 
      Prop.SetValue(Control, Valeur.VBoolean); 
    vtChar: 
      Prop.SetValue(Control, Valeur.VChar); 
    vtExtended: 
      Prop.SetValue(Control, Valeur.VExtended^); 
    vtString: 
      Prop.SetValue(Control, Valeur.VString^); 
    vtWideChar: 
      Prop.SetValue(Control, Valeur.VWideChar); 
    vtAnsiString: 
      Prop.SetValue(Control, AnsiString(Valeur.VAnsiString^)); 
    vtWideString: 
      Prop.SetValue(Control, WideString(Valeur.VWideString^)); 
    vtInt64: 
      Prop.SetValue(Control, Int64(Valeur.VInt64)); 
    vtUnicodeString: 
      Prop.SetValue(Control, UnicodeString(Valeur.VUnicodeString)); 
  end; 
end; 
  
class procedure TStateManager.ChangeState(OwnerCtrls: TWinControl; 
  PropNames: array of string; Values: array of const); 
var 
  I, J: Integer; 
  Ctx : TRttiContext; 
  Typ : TRttiType; 
  Prop: TRttiProperty; 
  P   : Pointer; 
begin 
  if not Assigned(OwnerCtrls) then 
    if Assigned(TStateManager.TheOwner) then 
      OwnerCtrls := TStateManager.TheOwner 
    else 
      raise Exception.Create('No defined Owner'); 
  
  for I := 0 to Pred(OwnerCtrls.ControlCount) do 
  begin 
    P := OwnerCtrls.Controls[I].ClassInfo; 
    if Assigned(P) then 
    begin 
      Typ := Ctx.GetType(P); 
      for J := Low(PropNames) to High(PropNames) do 
      begin 
        Prop := Typ.GetProperty(PropNames[J]); 
        if Assigned(Prop) then 
          AssignValue(OwnerCtrls.Controls[I], Prop, Values[J]); 
      end; 
    end; 
  end; 
end; 
  
class procedure TStateManager.EnableCtrls(OwnerCtrls: TWinControl; 
  State: Boolean; EnabledOrReaddOnly: Boolean); 
var 
  I   : Integer; 
  Ctx : TRttiContext; 
  Typ : TRttiType; 
  Prop: TRttiProperty; 
  P   : Pointer; 
  Vl  : TVarRec; 
begin 
  
  if not Assigned(OwnerCtrls) then 
    if Assigned(TStateManager.TheOwner) then 
      OwnerCtrls := TStateManager.TheOwner 
    else 
      raise Exception.Create('No defined Owner'); 
  
  Vl.VType := vtBoolean; 
  Vl.VBoolean := State; 
  
  for I := 0 to Pred(OwnerCtrls.ControlCount) do 
  begin 
    P := OwnerCtrls.Controls[I].ClassInfo; 
  
    if Assigned(P) then 
    begin 
      Typ := Ctx.GetType(P); 
  
      Prop := Typ.GetProperty('Enabled'); 
      if Assigned(Prop) then 
        AssignValue(OwnerCtrls.Controls[I], Prop, Vl) 
      else 
      begin 
        if EnabledOrReaddOnly then 
        begin 
          Prop := Typ.GetProperty('ReadOnly'); 
          if Assigned(Prop) then 
            AssignValue(OwnerCtrls.Controls[I], Prop, Vl) 
        end; 
      end; 
  
    end; 
  
    Prop := nil; 
  end; 
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
unit Unit5; 
  
interface 
  
uses 
  Winapi.Windows, Winapi.Messages, 
  System.SysUtils, System.Variants, System.Classes, System.Rtti, System.TypInfo, 
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Mask, 
  Vcl.Wwdbedit, Vcl.ExtCtrls, Vcl.Wwdotdot, Vcl.Wwdbcomb; 
  
type 
  TForm5 = class(TForm) 
    Edit1: TEdit; 
    Label1: TLabel; 
    Button1: TButton; 
    RadioButton1: TRadioButton; 
    Panel1: TPanel; 
    wwDBEdit1: TwwDBEdit; 
    Memo1: TMemo; 
    wwDBComboBox1: TwwDBComboBox; 
    Panel2: TPanel; 
    Memo2: TMemo; 
    procedure FormDblClick(Sender: TObject); 
  end; 
  
var 
  Form5: TForm5; 
  
implementation 
  
{$R *.dfm} 
  
uses UStateManager; 
  
procedure TForm5.FormDblClick(Sender: TObject); 
begin 
  
  TStateManager.TheOwner := Panel2; 
  TStateManager.ChangeState(nil, ['color', 'readonly', 'Text'], [clYellow, False, 'Hello']); 
  // or ... 
  TStateManager.ChangeState(Panel2, ['color', 'readonly', 'Text'], [clYellow, False, 'Hello']); 
  
  TStateManager.EnableCtrls(Panel2, False, True); 
end; 
  
end.