Delphi Folha de referência

program Demo;          // program keyword starts a console app

{$APPTYPE CONSOLE}      // compiler directive: console application

uses                    // import units (like #include or import)
  System.SysUtils,      // utilities (Format, IntToStr, etc.)
  System.Classes;       // TList, TStrings, etc.

// a unit has interface (declarations) and implementation (bodies)
// unit Math;
// interface
//   function Add(A, B: Integer): Integer;
// implementation
//   function Add(A, B: Integer): Integer;
//   begin Result := A + B; end;
// end.

var
  Name: string;
begin
  Name := 'Alice';
  WriteLn('Hello, ', Name, '!');    // WriteLn = output with newline
  Write('No newline');              // Write = output without newline
  ReadLn;                           // wait for Enter (pause)
end.

var
  Name: string = 'Alice';        // string (managed, reference-counted)
  Age: Integer = 30;             // 32-bit signed integer
  BigNum: Int64 = 9223372036854775807;  // 64-bit
  Pi: Double = 3.14159;          // 64-bit float (IEEE 754)
  E: Extended = 2.71828;         // 80-bit float (x87)
  Rate: Single = 0.5;            // 32-bit float
  Ch: Char = 'A';                // 2-byte Unicode char (WideChar)
  IsDev: Boolean = True;         // True/False
  Bytes: Byte = 255;             // 0..255
  Date: TDateTime;               // date/time (double)

// constants
const
  MaxRetries = 3;                // untyped constant
  Pi: Double = 3.14159265;       // typed constant
  Greeting: string = 'Hello';

// type aliases
type
  TAge = 0..150;                 // subrange type
  TDay = (Mon, Tue, Wed, Thu, Fri, Sat, Sun);  // enumeration

begin
  Date := Now;                   // current date/time
  WriteLn(Format('%s is %d', [Name, Age]));   // formatted output
  WriteLn('Pi = ', Pi:0:2);      // 3.14 (width:decimals)
end;

var
  A, B: Integer;
  X, Y: Double;
  S1, S2: string;
begin
  A := 10; B := 3;
  WriteLn(A + B);    // 13 (addition)
  WriteLn(A - B);    // 7
  WriteLn(A * B);    // 30
  WriteLn(A div B);  // 3 (integer division)
  WriteLn(A mod B);  // 1 (remainder)
  WriteLn(A / B);    // 3.33 (real division, always Extended)

  X := 2.0; Y := 3.0;
  WriteLn(X + Y);    // 5.0
  WriteLn(Power(X, Y)); // 8.0 (needs System.Math)

  // comparison (return Boolean)
  WriteLn(A > B);    // TRUE
  WriteLn(A = B);    // FALSE (= is equality, not assignment!)
  WriteLn(A <> B);   // TRUE (not equal)
  WriteLn(A >= B);   // TRUE

  // logical operators
  WriteLn(True and False);  // FALSE
  WriteLn(True or False);   // TRUE
  WriteLn(not True);        // FALSE
  WriteLn(True xor False);  // TRUE

  // string concatenation
  S1 := 'Hello'; S2 := 'World';
  WriteLn(S1 + ', ' + S2 + '!');  // Hello, World!

  // bitwise (on integers)
  WriteLn(5 and 3);  // 1
  WriteLn(5 or 3);   // 7
  WriteLn(5 shl 1);  // 10 (shift left = *2)
  WriteLn(5 shr 1);  // 2 (shift right = /2)

  // Inc and Dec (modify in place)
  Inc(A);      // A := A + 1
  Inc(A, 5);   // A := A + 5
  Dec(A);      // A := A - 1
end;

var
  Name: string;
  Age: Integer;
  Salary: Double;
begin
  // console output
  WriteLn('Hello, World!');        // with newline
  Write('No newline');             // without
  WriteLn;                         // just a newline

  // formatted output with Format (like sprintf)
  WriteLn(Format('Name: %s, Age: %d', ['Alice', 30]));
  WriteLn(Format('Pi: %.4f', [3.14159]));      // Pi: 3.1416
  WriteLn(Format('Hex: %x', [255]));            // Hex: FF
  WriteLn(Format('Pad: %10d', [42]));           // right-aligned
  WriteLn(Format('Left: %-10d|', [42]));        // left-aligned
  WriteLn(Format('Money: %m', [1234.56]));      // currency

  // WriteLn with format specifiers (width:decimals)
  WriteLn(3.14159:0:2);    // 3.14
  WriteLn(42:5);           //    42 (width 5)

  // console input
  Write('Enter your name: ');
  ReadLn(Name);
  Write('Enter your age: ');
  ReadLn(Age);

  // type conversion functions
  Salary := StrToFloat('50000.50');
  Age := StrToInt('30');
  WriteLn(IntToStr(42));              // '42'
  WriteLn(FloatToStr(3.14));          // '3.14'
  WriteLn(FloatToStrF(3.14159, ffFixed, 8, 2));  // '3.14'
  WriteLn(FormatDateTime('yyyy-mm-dd', Now));    // '2024-06-18'

  // TryStrToInt (safe parsing)
  if TryStrToInt('123', Age) then
    WriteLn('Parsed: ', Age);
end;

// Unit declaration
unit MathHelper;

interface

uses
  System.SysUtils;

// public types (visible to users of the unit)
type
  TCalculator = class
  public
    function Add(A, B: Integer): Integer;
  end;

// public constants
const
  Pi = 3.14159265358979;

// public variables
var
  Counter: Integer;

// public function declarations
function Multiply(A, B: Integer): Integer;

implementation

// private types (only visible inside this unit's implementation)
type
  TInternal = record
    Value: Integer;
  end;

// private variables
var
  InternalCount: Integer;

// function body (implementation)
function Multiply(A, B: Integer): Integer;
begin
  Result := A * B;
end;

function TCalculator.Add(A, B: Integer): Integer;
begin
  Result := A + B;
end;

initialization
  // runs when the unit loads
  Counter := 0;
  InternalCount := 0;

finalization
  // runs when the unit unloads (cleanup)
  // free resources here

end.

var
  Score: Integer;
  Grade: string;
begin
  Score := 85;

  // simple if
  if Score >= 60 then
    WriteLn('Pass');

  // if-else (no semicolon before 'else'!)
  if Score >= 90 then
    Grade := 'A'
  else if Score >= 80 then
    Grade := 'B'
  else if Score >= 70 then
    Grade := 'C'
  else
    Grade := 'F';

  WriteLn('Grade: ', Grade);

  // multi-statement if (needs begin..end)
  if Score > 50 then
  begin
    WriteLn('Passed');
    WriteLn('Congratulations');
  end
  else
  begin
    WriteLn('Failed');
    WriteLn('Try again');
  end;

  // nested with logical operators
  if (Score >= 0) and (Score <= 100) then
    WriteLn('Valid score');
end;

var
  Grade: Char;
  Day: Integer;
begin
  Grade := 'B';

  // case on ordinal (integer, char, enum)
  case Grade of
    'A': WriteLn('Excellent');
    'B': WriteLn('Good');
    'C': WriteLn('Average');
    'D', 'F': WriteLn('Poor');     // multiple values
  else
    WriteLn('Invalid grade');       // default (else clause)
  end;

  // case with ranges
  Day := 3;
  case Day of
    1..5: WriteLn('Weekday');       // range
    6, 7: WriteLn('Weekend');
  else
    WriteLn('Invalid day');
  end;

  // case with enums
  type TColor = (Red, Green, Blue);
  var C: TColor;
  C := Green;
  case C of
    Red: WriteLn('Stop');
    Green: WriteLn('Go');
    Blue: WriteLn('Relax');
  end;

  // case with multi-statement branches
  case Grade of
    'A': begin
           WriteLn('Excellent');
           WriteLn('Keep it up');
         end;
    'B': WriteLn('Good');
  end;
end;

var
  i: Integer;
  Fruits: array of string;
  S: string;
begin
  // for...to (ascending)
  for i := 1 to 5 do
    WriteLn(i);          // 1 2 3 4 5

  // for...downto (descending)
  for i := 5 downto 1 do
    WriteLn(i);          // 5 4 3 2 1

  // for with step (no built-in step — use a while or compute)
  for i := 0 to 9 do
    if i mod 2 = 0 then
      WriteLn(i);        // 0 2 4 6 8

  // nested loops
  for i := 1 to 3 do
    for j := 1 to 3 do
      Write(i * j, ' ');
  WriteLn;

  // for...in (iterates collections, modern Delphi)
  Fruits := ['apple', 'banana', 'cherry'];
  for S in Fruits do
    WriteLn(S);

  // for...in on string (iterates characters)
  for S in 'Hello' do
    Write(S, ' ');       // H e l l o
  WriteLn;

  // for...in on set
  type TDigits = set of 1..5;
  var D: TDigits := [1, 3, 5];
  for i in D do
    WriteLn(i);          // 1 3 5

  // Break and Continue
  for i := 1 to 100 do
  begin
    if i > 10 then Break;       // exit loop
    if i mod 2 = 0 then Continue; // skip to next iteration
    WriteLn(i);                  // 1 3 5 7 9
  end;
end;

var
  Count: Integer;
  Line: string;
begin
  // while: test BEFORE (may never run)
  Count := 0;
  while Count < 3 do
  begin
    WriteLn(Count);
    Inc(Count);
  end;
  // 0 1 2

  // repeat...until: test AFTER (runs at least once)
  Count := 0;
  repeat
    WriteLn(Count);
    Inc(Count);
  until Count >= 3;
  // 0 1 2

  // KEY DIFFERENCE: while continues while TRUE; until stops when TRUE
  // while X < 3 do ...  ==  repeat ... until X >= 3

  // repeat doesn't need begin..end (it's already a block)
  Count := 5;
  repeat
    WriteLn(Count);
    Dec(Count);
  until Count = 0;

  // reading input until a condition
  repeat
    Write('Enter "quit" to stop: ');
    ReadLn(Line);
  until (Line = 'quit') or (Line = 'exit');

  // infinite loop with Break
  while True do
  begin
    WriteLn('Running...');
    if SomeCondition then Break;
  end;

  // Continue in while
  Count := 0;
  while Count < 10 do
  begin
    Inc(Count);
    if Count mod 2 = 0 then Continue;
    WriteLn(Count);   // 1 3 5 7 9
  end;
end;

type
  TPerson = record
    Name: string;
    Age: Integer;
    Email: string;
  end;

var
  P: TPerson;
  i: Integer;
label
  RetryPoint;   // declare a label for Goto
begin
  // With...Do: access record/object members without repeating the name
  with P do
  begin
    Name := 'Alice';
    Age := 30;
    Email := '[email protected]';
    WriteLn(Name, ' is ', Age);   // instead of P.Name, P.Age
  end;

  // With on a function result
  with TStringList.Create do
  try
    Add('line 1');
    Add('line 2');
    SaveToFile('output.txt');
  finally
    Free;
  end;

  // nested With (avoid — ambiguous)
  with P, TStringList.Create do
  try
    Add(Name);   // Name could be P.Name or TStringList.Name
  finally
    Free;
  end;

  // Goto (rarely used — prefer structured alternatives)
  i := 0;
RetryPoint:
  Inc(i);
  WriteLn('Attempt ', i);
  if i < 3 then
    Goto RetryPoint;
  WriteLn('Done after ', i, ' attempts');

  // Exit: leave the current procedure/function
  if P.Age < 0 then
  begin
    WriteLn('Invalid age');
    Exit;          // return immediately
  end;

  // Exit with a value (for functions)
  // Exit(42);  // returns 42 from the function
end;

var
  S: string;           // UnicodeString (default, UTF-16, reference-counted)
  A: AnsiString;       // 8-bit string (legacy, codepage-aware)
  W: WideString;       // COM-compatible (not reference-counted)
  SB: StringBuilder;   // mutable, for heavy concatenation
begin
  S := 'Hello, World';

  // length and indexing (1-indexed!)
  WriteLn(Length(S));        // 12
  WriteLn(S[1]);             // 'H' (first char — 1-indexed!)
  WriteLn(S[Length(S)]);     // 'd' (last char)

  // case conversion
  WriteLn(UpperCase(S));     // HELLO, WORLD
  WriteLn(LowerCase(S));     // hello, world

  // searching
  WriteLn(Pos('World', S));  // 8 (1-indexed position, 0 if not found)
  WriteLn(Pos('xyz', S));    // 0

  // substring
  WriteLn(Copy(S, 1, 5));    // 'Hello' (Start, Length)
  WriteLn(Copy(S, 8, 5));    // 'World'

  // modify (creates new string — strings are immutable-ish)
  S := StringReplace(S, 'World', 'Delphi', [rfReplaceAll]);
  WriteLn(S);                // Hello, Delphi

  // trim
  WriteLn(Trim('  hi  '));        // 'hi'
  WriteLn(TrimLeft('  hi  '));    // 'hi  '
  WriteLn(TrimRight('  hi  '));   // '  hi'

  // split
  var Parts: TArray<string>;
  Parts := 'a,b,c'.Split([',']);
  WriteLn(Length(Parts));    // 3

  // join
  WriteLn(string.Join('-', Parts));  // 'a-b-c'

  // comparison
  WriteLn('abc' = 'abc');    // TRUE (case-sensitive)
  WriteLn(AnsiCompareText('ABC', 'abc'));  // 0 (case-insensitive)
  WriteLn(SameText('ABC', 'abc'));         // TRUE
end;

var
  N: Integer := 42;
  F: Double := 3.14159;
  S: string;
  D: TDateTime := Now;
begin
  // Format (like sprintf)
  S := Format('Integer: %d', [N]);              // 'Integer: 42'
  S := Format('Float: %f', [F]);                // 'Float: 3.14'
  S := Format('Float: %.4f', [F]);              // 'Float: 3.1416'
  S := Format('Hex: %x', [N]);                  // 'Hex: 2a'
  S := Format('String: %s', ['Hello']);         // 'String: Hello'
  S := Format('Padded: %10d', [N]);             // '        42'
  S := Format('Left: %-10d|', [N]);             // '42        |'
  S := Format('Multiple: %s=%d, %.2f', ['x', N, F]);

  // FloatToStrF (precise float formatting)
  S := FloatToStrF(F, ffFixed, 8, 2);           // '3.14'
  S := FloatToStrF(F, ffCurrency, 8, 2);        // '$3.14'
  S := FloatToStrF(1234567, ffNumber, 10, 0);   // '1,234,567'

  // date/time formatting
  S := FormatDateTime('yyyy-mm-dd', D);         // '2024-06-18'
  S := FormatDateTime('hh:nn:ss', D);           // '14:30:00'
  S := FormatDateTime('dddd, mmmm d, yyyy', D); // 'Tuesday, June 18, 2024'

  // string to number (throws on invalid)
  N := StrToInt('123');
  F := StrToFloat('3.14');
  D := StrToDateTime('2024-06-18');

  // safe parsing (TryStrTo...)
  if TryStrToInt('123', N) then
    WriteLn('Parsed: ', N);
  if TryStrToInt('abc', N) then
    WriteLn('Valid')
  else
    WriteLn('Invalid number');

  // IntToStr, FloatToStr
  WriteLn(IntToStr(42));
  WriteLn(FloatToStr(3.14));
end;

uses
  System.SysUtils, System.Classes;

var
  sb: StringBuilder;
  SL: TStringList;
  i: Integer;
begin
  // StringBuilder: efficient concatenation (mutable)
  sb := StringBuilder.Create;
  try
    for i := 1 to 1000 do
      sb.Append('Line ').Append(i).AppendLine;  // chainable
    WriteLn(sb.ToString);
  finally
    sb.Free;
  end;

  // TStringList: versatile string collection
  SL := TStringList.Create;
  try
    // add items
    SL.Add('apple');
    SL.Add('banana');
    SL.Add('cherry');
    WriteLn(SL.Count);          // 3
    WriteLn(SL[0]);             // 'apple' (0-indexed!)

    // sort and find
    SL.Sort;
    SL.Sorted := True;          // auto-sort on Add
    idx := SL.IndexOf('banana');  // find (returns -1 if not found)

    // comma-separated text
    SL.CommaText := 'red,green,blue';   // split into items
    WriteLn(SL.CommaText);               // 'blue,green,red'

    // key=value pairs
    SL.Clear;
    SL.Values['name'] := 'Alice';
    SL.Values['age'] := '30';
    WriteLn(SL.Values['name']);  // 'Alice'

    // file I/O (one line per item)
    SL.SaveToFile('items.txt');
    SL.LoadFromFile('items.txt');

    // delimited text
    SL.Delimiter := ';';
    SL.DelimitedText := 'a;b;c';
  finally
    SL.Free;
  end;
end;

var
  C: Char;
  S: string;
  Bytes: TBytes;
  i: Integer;
begin
  C := 'A';
  WriteLn(Ord(C));              // 65 (ASCII/Unicode code point)
  WriteLn(Char(66));            // 'B' (code point to char)

  // char classification
  WriteLn(IsDigit('5'));        // TRUE
  WriteLn(IsLetter('A'));       // TRUE
  WriteLn(IsWhiteSpace(' '));   // TRUE
  WriteLn(IsUpper('A'));        // TRUE
  WriteLn(IsLower('a'));        // TRUE

  // case conversion
  WriteLn(ToUpper('a'));        // 'A'
  WriteLn(ToLower('A'));        // 'a'

  // iterate characters
  S := 'Hello';
  for C in S do
    Write(C, '(', Ord(C), ') ');
  WriteLn;   // H(72) e(101) l(108) l(108) o(111)

  // string <-> bytes (encoding)
  Bytes := TEncoding.UTF8.GetBytes('Hello');
  WriteLn(Length(Bytes));       // 5 (ASCII chars are 1 byte in UTF-8)
  Bytes := TEncoding.UTF8.GetBytes('héllo');
  WriteLn(Length(Bytes));       // 6 (é is 2 bytes in UTF-8)

  S := TEncoding.UTF8.GetString(Bytes);  // back to string

  // other encodings
  Bytes := TEncoding.ASCII.GetBytes('Hello');
  Bytes := TEncoding.Unicode.GetBytes('Hello');  // UTF-16 LE (2 bytes/char)

  // Base64 encoding (for binary in text)
  uses System.NetEncoding;
  var B64: string := TNetEncoding.Base64.EncodeBytesToString(Bytes);
  var Decoded: TBytes := TNetEncoding.Base64.DecodeStringToBytes(B64);

  // char arrays
  var Chars: array[0..4] of Char;
  Chars[0] := 'H'; Chars[1] := 'e'; Chars[2] := 'l'; Chars[3] := 'l'; Chars[4] := 'o';
  S := String(Chars);   // convert char array to string
end;

uses
  System.RegularExpressions;

var
  Input, Pattern: string;
  Match: TMatch;
  Matches: TMatchCollection;
  Result: string;
begin
  Input := 'Phone: 123-456-7890, Zip: 10001';

  // check if matches
  if TRegEx.IsMatch(Input, 'd{3}-d{3}-d{4}') then
    WriteLn('Found a phone number');

  // find first match
  Match := TRegEx.Match(Input, 'd{5}');
  if Match.Success then
    WriteLn('Zip: ', Match.Value);   // '10001'

  // find all matches
  Matches := TRegEx.Matches(Input, 'd+');
  for Match in Matches do
    WriteLn(Match.Value);   // 123, 456, 7890, 10001

  // capture groups
  Match := TRegEx.Match('2024-06-18', '(d{4})-(d{2})-(d{2})');
  if Match.Success then
  begin
    WriteLn(Match.Groups[1].Value);  // '2024' (year)
    WriteLn(Match.Groups[2].Value);  // '06' (month)
    WriteLn(Match.Groups[3].Value);  // '18' (day)
  end;

  // replace
  Result := TRegEx.Replace(Input, 'd', 'X');
  // 'Phone: XXX-XXX-XXXX, Zip: XXXXX'

  // replace with match reference ($1, $2)
  Result := TRegEx.Replace('John Doe', '(w+) (w+)', '$2, $1');
  // 'Doe, John'

  // split
  var Parts: TArray<string>;
  Parts := TRegEx.Split('a,b;;c', '[,;]+');

  // common patterns
  Pattern := '^[w.-]+@[w.-]+.w+$';   // email
  Pattern := '^https?://[w./-]+$';       // URL
  Pattern := '^d{3}-d{3}-d{4}$';       // US phone

  // compiled regex (faster for repeated use)
  var Regex := TRegEx.Create('d+', [roCompiled]);
  try
    Match := Regex.Match(Input);
  finally
    Regex.Free;
  end;
end;

var
  // static array (fixed size, compile-time)
  Nums: array[0..4] of Integer;        // 5 elements, indices 0..4
  Matrix: array[0..2, 0..2] of Double; // 3x3 2D array
  Days: array[1..7] of string;         // 1-indexed (custom range)

  // dynamic array (resizable at runtime)
  Dyn: array of Integer;
  Dyn2D: array of array of Integer;    // jagged 2D
  i, j: Integer;
begin
  // static array
  Nums[0] := 10;
  Nums[1] := 20;
  for i := 0 to High(Nums) do   // High(Nums) = 4
    WriteLn(Nums[i]);
  WriteLn(Length(Nums));         // 5

  // dynamic array
  SetLength(Dyn, 5);             // allocate 5 elements (0-indexed)
  Dyn[0] := 1;
  Dyn[1] := 2;
  for i := 0 to High(Dyn) do
    WriteLn(Dyn[i]);

  SetLength(Dyn, 10);            // resize (preserves existing values)
  WriteLn(Length(Dyn));          // 10

  Dyn := nil;                    // free memory

  // dynamic array literal (modern Delphi)
  Dyn := [1, 2, 3, 4, 5];
  WriteLn(Length(Dyn));          // 5

  // 2D dynamic array
  SetLength(Dyn2D, 3);           // 3 rows
  for i := 0 to 2 do
  begin
    SetLength(Dyn2D[i], 3);      // 3 cols per row
    for j := 0 to 2 do
      Dyn2D[i][j] := i * 3 + j;
  end;

  // array slice (Open Array)
  WriteLn(Length(Dyn));          // 5
end;

type
  // simple record (like a struct)
  TPoint = record
    X, Y: Integer;
  end;

  // record with methods (modern Delphi)
  TPerson = record
    Name: string;
    Age: Integer;
    // methods
    function Greet: string;
    procedure Birthday;
    // properties
    property IsAdult: Boolean read GetIsAdult;
  private
    function GetIsAdult: Boolean;
  end;

  // variant record (union — fields share memory)
  TValue = record
    case IsInt: Boolean of
      True: (IntVal: Integer);
      False: (FloatVal: Double);
  end;

// implementing record methods
function TPerson.Greet: string;
begin
  Result := 'Hi, I am ' + Name;
end;

procedure TPerson.Birthday;
begin
  Inc(Age);
end;

function TPerson.GetIsAdult: Boolean;
begin
  Result := Age >= 18;
end;

var
  P: TPerson;
  Pt: TPoint;
  V: TValue;
begin
  // record assignment copies all fields (value type)
  P.Name := 'Alice';
  P.Age := 30;
  WriteLn(P.Greet);       // Hi, I am Alice
  P.Birthday;
  WriteLn(P.Age);         // 31
  WriteLn(P.IsAdult);     // TRUE

  // record constructors (modern Delphi)
  P := TPerson.Create;    // zero-initializes
  P.Name := 'Bob';

  // variant record
  V.IsInt := True;
  V.IntVal := 42;
  WriteLn(V.IntVal);      // 42
  V.IsInt := False;
  V.FloatVal := 3.14;
  WriteLn(V.FloatVal);    // 3.14
end;

type
  // enumeration
  TDay = (Mon, Tue, Wed, Thu, Fri, Sat, Sun);
  TColor = (Red, Green, Blue);

  // set type (collection of enum values)
  TDays = set of TDay;
  TColors = set of TColor;
  TChars = set of Char;     // set of characters

var
  Weekdays: TDays;
  MyColors: TColors;
  D: TDay;
  Digits: TChars;
  C: Char;
begin
  // set operations
  Weekdays := [Mon, Tue, Wed, Thu, Fri];
  MyColors := [Red, Blue];

  // add and remove
  Include(Weekdays, Sat);    // Weekdays := Weekdays + [Sat]
  Exclude(Weekdays, Sun);    // Weekdays := Weekdays - [Sun]

  // set operators
  Weekdays := Weekdays + [Sat];     // union
  Weekdays := Weekdays - [Sat];     // difference
  Weekend := [Sat, Sun];
  if Weekdays * Weekend = [] then   // intersection is empty
    WriteLn('No overlap');

  // membership test
  if Mon in Weekdays then
    WriteLn('Monday is a weekday');

  // iterate enum
  for D := Low(TDay) to High(TDay) do
    WriteLn(D);              // 0 1 2 3 4 5 6 (ord values)

  // convert enum to string
  WriteLn(GetEnumName(TypeInfo(TDay), Ord(Mon)));  // 'Mon'

  // set of Char (common for validation)
  Digits := ['0'..'9'];
  C := '5';
  if C in Digits then
    WriteLn('Is a digit');

  // set comparison
  if MyColors = [Red, Blue] then
    WriteLn('Equal sets');
  if [Red] <= MyColors then     // subset
    WriteLn('Red is included');
end;

uses
  System.Generics.Collections;

var
  Nums: TList<Integer>;
  Ages: TDictionary<string, Integer>;
  Unique: THashSet<string>;
  Queue: TQueue<string>;
  Stack: TStack<Integer>;
  i: Integer;
  K: string;
  V: Integer;
begin
  // TList<T>: dynamic array (generic)
  Nums := TList<Integer>.Create;
  try
    Nums.Add(1);
    Nums.Add(2);
    Nums.AddRange([3, 4, 5]);
    WriteLn(Nums.Count);          // 5
    WriteLn(Nums[0]);             // 1 (0-indexed)
    Nums[0] := 100;
    Nums.Remove(2);               // by value
    Nums.Delete(0);               // by index
    Nums.Sort;                    // sort in place
    Nums.Reverse;
    if Nums.Contains(3) then
      WriteLn('Found');
    for i in Nums do
      WriteLn(i);
  finally
    Nums.Free;
  end;

  // TDictionary<TKey, TValue>: hash map
  Ages := TDictionary<string, Integer>.Create;
  try
    Ages.Add('Alice', 30);
    Ages.Add('Bob', 25);
    Ages['Eve'] := 28;            // add or update
    if Ages.TryGetValue('Alice', V) then
      WriteLn('Alice is ', V);    // 30
    for K in Ages.Keys do
      WriteLn(K);
    for V in Ages.Values do
      WriteLn(V);
    Ages.Remove('Bob');
  finally
    Ages.Free;
  end;

  // TQueue<T> (FIFO) and TStack<T> (LIFO)
  Queue := TQueue<string>.Create;
  try
    Queue.Enqueue('first');
    Queue.Enqueue('second');
    WriteLn(Queue.Dequeue);       // 'first'
  finally
    Queue.Free;
  end;

  // TObjectList<T> (owns its objects — frees them on Clear/Free)
  // uses System.Generics.Collections;
  // var People: TObjectList<TPerson>;
  // People := TObjectList<TPerson>.Create;
  // People.Add(TPerson.Create);  // freed when People is freed
end;

uses
  System.Generics.Collections, System.Generics.Defaults;

var
  Nums: TArray<Integer>;
  People: TArray<TPerson>;
  i: Integer;
begin
  // sort an array
  Nums := TArray<Integer>.Create(5, 3, 1, 4, 2);
  TArray.Sort<Integer>(Nums);
  // Nums = [1, 2, 3, 4, 5]

  // sort descending (custom comparer)
  TArray.Sort<Integer>(Nums, TComparer<Integer>.Construct(
    function(const L, R: Integer): Integer
    begin
      Result := R - L;   // reverse comparison
    end));

  // binary search (array must be sorted)
  TArray.Sort<Integer>(Nums);
  var Found: Boolean := TArray.BinarySearch<Integer>(Nums, 3, i);
  if Found then
    WriteLn('Found at index ', i);

  // sort array of records by a field
  type TPerson = record Name: string; Age: Integer; end;
  SetLength(People, 3);
  People[0] := TPerson.Create('Alice', 30);
  People[1] := TPerson.Create('Bob', 25);
  People[2] := TPerson.Create('Carol', 28);

  TArray.Sort<TPerson>(People, TComparer<TPerson>.Construct(
    function(const L, R: TPerson): Integer
    begin
      Result := L.Age - R.Age;   // sort by age
    end));

  for i := 0 to High(People) do
    WriteLn(People[i].Name, ': ', People[i].Age);

  // reverse an array
  TArray.Reverse<Integer>(Nums);

  // copy an array
  var Copy: TArray<Integer>;
  Copy := Copy(Nums, 0, Length(Nums));

  // find with a predicate
  var FoundIdx: Integer := -1;
  for i := 0 to High(People) do
    if People[i].Age > 28 then
    begin
      FoundIdx := i;
      Break;
    end;
end;

// Procedure: performs an action (no return value)
procedure Greet(Name: string);
begin
  WriteLn('Hello, ', Name, '!');
end;

// Function: returns a value
function Add(A, B: Integer): Integer;
begin
  Result := A + B;          // Result is the return variable
  // Exit(42);              // alternative: return immediately with 42
end;

// Function with multiple return paths
function Classify(Score: Integer): string;
begin
  if Score >= 90 then
    Exit('A');              // return immediately
  if Score >= 80 then
    Exit('B');
  Result := 'F';            // default return
end;

// Function returning a record
function MakePoint(X, Y: Integer): TPoint;
begin
  Result.X := X;
  Result.Y := Y;
end;

// forward declaration (use before full definition)
function Calc(X: Integer): Integer; forward;

procedure Demo;
var
  Sum: Integer;
  P: TPoint;
begin
  Greet('Alice');               // procedure call
  Sum := Add(3, 4);             // function call
  WriteLn(Sum);                 // 7
  WriteLn(Classify(85));        // B
  P := MakePoint(3, 4);
  WriteLn(Calc(10));
end;

function Calc(X: Integer): Integer;
begin
  Result := X * 2;
end;

// const: can't be modified (also efficient for strings/arrays)
procedure Show(const S: string);
begin
  WriteLn(S);
  // S := 'new';  // ERROR: can't modify const
end;

// var: pass by reference (can modify caller's variable)
procedure Swap(var A, B: Integer);
var
  Temp: Integer;
begin
  Temp := A;
  A := B;
  B := Temp;
end;

// out: output-only parameter (caller doesn't need to initialize)
procedure GetValues(out X, Y: Integer);
begin
  X := 10;
  Y := 20;
end;

// default parameters (must be at the end)
function Power(Base: Double; Exp: Integer = 2): Double;
begin
  Result := Power(Base, Exp);   // Math.Power
end;

// open array parameter (accepts any array)
function Sum(const Values: array of Integer): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to High(Values) do
    Result := Result + Values[i];
end;

// 'const' for open arrays (efficient — no copy)
procedure ShowAll(const Items: array of string);
var
  S: string;
begin
  for S in Items do
    WriteLn(S);
end;

var
  X, Y: Integer;
  Nums: array[0..4] of Integer;
begin
  Swap(X, Y);              // var: modifies X and Y
  GetValues(X, Y);         // out: sets X and Y
  WriteLn(Power(3));       // 9 (Exp defaults to 2)
  WriteLn(Power(2, 10));   // 1024
  WriteLn(Sum([1, 2, 3, 4, 5]));   // 15 (open array literal)
  ShowAll(['a', 'b', 'c']);
end;

// overloading: same name, different parameters
function Add(A, B: Integer): Integer; overload;
begin
  Result := A + B;
end;

function Add(A, B: Double): Double; overload;
begin
  Result := A + B;
end;

function Add(A, B, C: Integer): Integer; overload;
begin
  Result := A + B + C;
end;

function Add(const Values: array of Integer): Integer; overload;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to High(Values) do
    Result := Result + Values[i];
end;

// default parameters (alternative to some overloads)
function CreateRect(Left, Top: Integer; Width: Integer = 100;
  Height: Integer = 50): TRect;
begin
  Result := Rect(Left, Top, Left + Width, Top + Height);
end;

var
  R: TRect;
begin
  WriteLn(Add(1, 2));           // 3 (Integer overload)
  WriteLn(Add(1.5, 2.5));       // 4.0 (Double overload)
  WriteLn(Add(1, 2, 3));        // 6 (3-arg overload)
  WriteLn(Add([1, 2, 3, 4]));   // 10 (array overload)

  R := CreateRect(10, 20);              // uses defaults: 100x50
  R := CreateRect(10, 20, 200);         // Width=200, Height=50
  R := CreateRect(10, 20, 200, 100);    // all specified
end;

type
  TMathFunc = reference to function(X: Integer): Integer;
  TNotifyProc = reference to procedure(Msg: string);

// function that takes a function
function Apply(Func: TMathFunc; Values: array of Integer): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to High(Values) do
    Result := Result + Func(Values[i]);
end;

// function that returns a function (closure)
function MakeMultiplier(Factor: Integer): TMathFunc;
begin
  Result := function(X: Integer): Integer
           begin
             Result := X * Factor;   // captures Factor
           end;
end;

var
  Double: TMathFunc;
  Triple: TMathFunc;
begin
  // anonymous method (inline function)
  Double := function(X: Integer): Integer
            begin
              Result := X * 2;
            end;

  WriteLn(Double(21));    // 42

  // use with higher-order functions
  WriteLn(Apply(Double, [1, 2, 3, 4]));   // 20 (2+4+6+8)

  // closure: captures the Factor variable
  Triple := MakeMultiplier(3);
  WriteLn(Triple(5));     // 15

  // anonymous procedure
  var Log: TNotifyProc := procedure(Msg: string)
    begin
      WriteLn('[LOG] ', Msg);
    end;
  Log('Hello');

  // use with TList.Sort (custom comparison)
  var Nums: TList<Integer>;
  Nums := TList<Integer>.Create;
  try
    Nums.AddRange([5, 3, 1, 4, 2]);
    Nums.Sort(TComparer<Integer>.Construct(
      function(const L, R: Integer): Integer
      begin
        Result := L - R;
      end));
  finally
    Nums.Free;
  end;
end;

// classic recursion
function Factorial(N: Integer): Integer;
begin
  if N <= 1 then
    Result := 1
  else
    Result := N * Factorial(N - 1);
end;

// tail recursion (compiler may optimize)
function SumRange(N: Integer; Acc: Integer = 0): Integer;
begin
  if N = 0 then
    Result := Acc
  else
    Result := SumRange(N - 1, Acc + N);
end;

// Fibonacci (naive — exponential time)
function Fib(N: Integer): Integer;
begin
  if N < 2 then
    Result := N
  else
    Result := Fib(N - 1) + Fib(N - 2);
end;

// nested procedure (helper with access to outer variables)
procedure ProcessData(Data: array of Integer);
var
  Total: Integer;

  procedure SumAll;     // nested, sees Total and Data
  var
    i: Integer;
  begin
    Total := 0;
    for i := 0 to High(Data) do
      Total := Total + Data[i];
  end;

  function Average: Double;   // nested function
  begin
    if Length(Data) = 0 then
      Result := 0
    else
      Result := Total / Length(Data);
  end;

begin
  SumAll;               // calls nested procedure
  WriteLn('Sum: ', Total);
  WriteLn('Avg: ', Average:0:2);
end;

begin
  WriteLn(Factorial(5));     // 120
  WriteLn(SumRange(10));     // 55
  WriteLn(Fib(10));          // 55
  ProcessData([1, 2, 3, 4, 5]);
end;

type
  TPerson = class
  private
    FName: string;          // private field (convention: F prefix)
    FAge: Integer;
    procedure SetAge(Value: Integer);   // setter for validation
  protected
    // visible to subclasses
    function GetDescription: string; virtual;
  public
    constructor Create(Name: string; Age: Integer);   // constructor
    destructor Destroy; override;                      // destructor
    // properties (with getters/setters)
    property Name: string read FName;                  // read-only
    property Age: Integer read FAge write SetAge;      // validated
    property Description: string read GetDescription;
    // method
    function Greet: string; virtual;
  end;

constructor TPerson.Create(Name: string; Age: Integer);
begin
  inherited Create;         // call base constructor (TObject.Create)
  FName := Name;
  FAge := Age;
end;

destructor TPerson.Destroy;
begin
  // free owned objects here
  inherited;                // call base destructor
end;

procedure TPerson.SetAge(Value: Integer);
begin
  if (Value < 0) or (Value > 150) then
    raise ERangeError.Create('Invalid age');
  FAge := Value;
end;

function TPerson.GetDescription: string;
begin
  Result := Format('%s (%d)', [FName, FAge]);
end;

function TPerson.Greet: string;
begin
  Result := 'Hi, I am ' + FName;
end;

var
  P: TPerson;
begin
  P := TPerson.Create('Alice', 30);
  try
    WriteLn(P.Greet);          // Hi, I am Alice
    WriteLn(P.Description);    // Alice (30)
    P.Age := 31;               // uses setter
    // P.Age := 200;           // raises ERangeError
  finally
    P.Free;                    // calls destructor
  end;
end;

type
  TList = class
  private
    FItems: array of Integer;
    FCount: Integer;
    function GetItem(Index: Integer): Integer;
    procedure SetItem(Index: Integer; Value: Integer);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(Value: Integer);
    // default array property (enables List[i] syntax)
    property Items[Index: Integer]: Integer read GetItem write SetItem; default;
    property Count: Integer read FCount;
  end;

constructor TList.Create;
begin
  inherited Create;
  FCount := 0;
end;

destructor TList.Destroy;
begin
  SetLength(FItems, 0);
  inherited;
end;

function TList.GetItem(Index: Integer): Integer;
begin
  if (Index < 0) or (Index >= FCount) then
    raise ERangeError.Create('Index out of range');
  Result := FItems[Index];
end;

procedure TList.SetItem(Index: Integer; Value: Integer);
begin
  if (Index < 0) or (Index >= FCount) then
    raise ERangeError.Create('Index out of range');
  FItems[Index] := Value;
end;

procedure TList.Add(Value: Integer);
begin
  Inc(FCount);
  SetLength(FItems, FCount);
  FItems[FCount - 1] := Value;
end;

var
  L: TList;
begin
  L := TList.Create;
  try
    L.Add(10);
    L.Add(20);
    WriteLn(L[0]);    // 10 (default property — no need for L.Items[0])
    L[1] := 99;       // uses setter
    WriteLn(L.Count); // 2
  finally
    L.Free;
  end;
end;

type
  TAnimal = class
  public
    constructor Create; virtual;       // virtual constructor (factory pattern)
    function Speak: string; virtual;   // virtual: can be overridden
    function Move: string;             // static: can't be overridden
  end;

  TDog = class(TAnimal)
  public
    constructor Create; override;
    function Speak: string; override;  // override the virtual method
  end;

  TCat = class(TAnimal)
  public
    function Speak: string; override;
  end;

constructor TAnimal.Create;
begin
  inherited;
end;

function TAnimal.Speak: string;
begin
  Result := '...';
end;

function TAnimal.Move: string;
begin
  Result := 'Moving';
end;

constructor TDog.Create;
begin
  inherited Create;    // call TAnimal.Create
  WriteLn('Dog created');
end;

function TDog.Speak: string;
begin
  Result := 'Woof';
end;

function TCat.Speak: string;
begin
  Result := 'Meow';
end;

// polymorphism: array of base class, different behaviors
var
  Animals: array of TAnimal;
  i: Integer;
begin
  SetLength(Animals, 3);
  Animals[0] := TDog.Create;
  Animals[1] := TCat.Create;
  Animals[2] := TAnimal.Create;

  for i := 0 to High(Animals) do
  begin
    WriteLn(Animals[i].Speak);   // Woof, Meow, ... (virtual dispatch)
    WriteLn(Animals[i].Move);    // Moving, Moving, Moving (static)
  end;

  for i := 0 to High(Animals) do
    Animals[i].Free;
end;

type
  TShape = class abstract        // can't be instantiated directly
  public
    function Area: Double; virtual; abstract;   // must be overridden
    function Perimeter: Double; virtual; abstract;
    procedure Describe; virtual;
    // class method (no instance needed)
    class function ShapeCount: Integer; static;
    class var FCount: Integer;    // class variable (shared)
  end;

  TCircle = class(TShape)
  private
    FRadius: Double;
  public
    constructor Create(Radius: Double);
    function Area: Double; override;
    function Perimeter: Double; override;
  end;

  TRectangle = class(TShape)
  private
    FWidth, FHeight: Double;
  public
    constructor Create(W, H: Double);
    function Area: Double; override;
    function Perimeter: Double; override;
  end;

class function TShape.ShapeCount: Integer;
begin
  Result := FCount;
end;

procedure TShape.Describe;
begin
  WriteLn(Format('Area: %.2f, Perimeter: %.2f', [Area, Perimeter]));
end;

constructor TCircle.Create(Radius: Double);
begin
  inherited Create;
  FRadius := Radius;
  Inc(FCount);
end;

function TCircle.Area: Double;
begin
  Result := Pi * FRadius * FRadius;
end;

function TCircle.Perimeter: Double;
begin
  Result := 2 * Pi * FRadius;
end;

var
  S: TShape;
begin
  // TShape.Create;  // ERROR: abstract class can't be instantiated
  S := TCircle.Create(5);
  try
    S.Describe;          // Area: 78.54, Perimeter: 31.42
    WriteLn(TShape.ShapeCount);  // class method (no instance)
  finally
    S.Free;
  end;
end;

type
  // interface: pure contract (no implementation, no fields)
  IComparable = interface
    function CompareTo(Other: TObject): Integer;
  end;

  IDrawable = interface
    procedure Draw;
  end;

  // interfaces have GUIDs (for QueryInterface / as operator)
  IDisposable = interface
    ['{12345678-1234-1234-1234-123456789012}']
    procedure Dispose;
  end;

  // class implementing multiple interfaces
  TButton = class(TInterfacedObject, IComparable, IDrawable, IDisposable)
  private
    FLabel: string;
  public
    constructor Create(ALabel: string);
    function CompareTo(Other: TObject): Integer;
    procedure Draw;
    procedure Dispose;
  end;

constructor TButton.Create(ALabel: string);
begin
  FLabel := ALabel;
end;

function TButton.CompareTo(Other: TObject): Integer;
begin
  Result := CompareText(FLabel, (Other as TButton).FLabel);
end;

procedure TButton.Draw;
begin
  WriteLn('Drawing button: ', FLabel);
end;

procedure TButton.Dispose;
begin
  WriteLn('Disposing ', FLabel);
end;

var
  Btn: TButton;
  Drawable: IDrawable;
  Comp: IComparable;
begin
  Btn := TButton.Create('OK');
  Btn.Draw;

  // assign to interface variable (reference counting!)
  Drawable := Btn as IDrawable;
  Drawable.Draw;

  Comp := Btn;
  WriteLn(Comp.CompareTo(Btn));   // 0

  // TInterfacedObject uses reference counting
  // when the last interface reference is released, the object is freed
  // (don't call Free on interface-referenced objects!)
end;

var
  F: TextFile;
  S: string;
begin
  // try...except: catch exceptions
  try
    AssignFile(F, 'nonexistent.txt');
    Reset(F);
    ReadLn(F, S);
    CloseFile(F);
  except
    on E: EFileNotFoundException do
      WriteLn('File not found: ', E.Message);
    on E: EInOutError do
      WriteLn('I/O error: ', E.Message);
    on E: Exception do   // catch-all (must be last)
      WriteLn('Unexpected: ', E.ClassName, ': ', E.Message);
  end;

  // try...finally: cleanup (always runs, even on exception)
  var SL: TStringList;
  SL := TStringList.Create;
  try
    SL.LoadFromFile('data.txt');
    WriteLn(SL.Text);
  finally
    SL.Free;   // ALWAYS runs, even if an exception occurred
  end;

  // combined: try...try...except...finally
  SL := TStringList.Create;
  try
    try
      SL.LoadFromFile('data.txt');
    except
      on E: Exception do
      begin
        WriteLn('Error loading: ', E.Message);
        SL.Clear;   // fallback
      end;
    end;
    WriteLn(SL.Text);
  finally
    SL.Free;
  end;

  // re-raise
  try
    RiskyOperation;
  except
    on E: Exception do
    begin
      WriteLn('Logging: ', E.Message);
      raise;   // re-raise the same exception
    end;
  end;
end;

uses
  System.SysUtils;

// raise built-in exceptions
procedure CheckAge(Age: Integer);
begin
  if Age < 0 then
    raise ERangeError.CreateFmt('Age cannot be negative: %d', [Age]);
  if Age > 150 then
    raise ERangeError.Create('Age unrealistic');
end;

// raise with inner exception (wrapping)
function LoadConfig(Path: string): string;
begin
  try
    Result := TFile.ReadAllText(Path);
  except
    on E: Exception do
      raise EConfigError.Create('Config load failed').SetInner(E);
  end;
end;

// custom exception class
type
  ETransactionError = class(Exception)
  private
    FTransactionId: string;
  public
    constructor Create(const Msg, TxnId: string);
    property TransactionId: string read FTransactionId;
  end;

constructor ETransactionError.Create(const Msg, TxnId: string);
begin
  inherited Create(Msg);
  FTransactionId := TxnId;
end;

// using the custom exception
procedure ProcessPayment(Amount: Double; TxnId: string);
begin
  if Amount <= 0 then
    raise ETransactionError.Create('Amount must be positive', TxnId);
  // ... process
end;

var
  E: Exception;
begin
  try
    CheckAge(-5);
  except
    on E: ERangeError do
      WriteLn('Range error: ', E.Message);
  end;

  try
    ProcessPayment(-100, 'TXN-001');
  except
    on E: ETransactionError do
      WriteLn('Transaction ', E.TransactionId, ' failed: ', E.Message);
  end;
end;

uses
  System.SysUtils, System.Diagnostics;

var
  Age: Integer;
  SW: TStopwatch;
begin
  // Assert: checks a condition (only in {$C+} / debug builds)
  Age := 30;
  Assert(Age >= 0, 'Age should be non-negative');
  // Assert(Age < 0, 'This will raise EAssertionFailed');

  // {$C+} / {$C-}: enable/disable assertions
  {$C-}   // disable assertions (release builds)
  Assert(False, 'This won''t fire');
  {$C+}   // re-enable

  // OutputDebugString (visible in IDE debugger)
  OutputDebugString('Processing started');

  // TStopwatch for timing
  SW := TStopwatch.StartNew;
  Sleep(100);
  SW.Stop;
  WriteLn(Format('Elapsed: %d ms', [SW.ElapsedMilliseconds]));

  // raise with stack trace (uses System.DebugUtils / JCLDebug)
  try
    raise Exception.Create('Test error');
  except
    on E: Exception do
    begin
      WriteLn(E.Message);
      WriteLn(E.StackTrace);   // needs debug info / map file
    end;
  end;

  // conditional compilation
  {$IFDEF DEBUG}
  WriteLn('Debug build');
  {$ELSE}
  WriteLn('Release build');
  {$ENDIF}

  // Trace (simple logging)
  {$IFDEF DEBUG}
  WriteLn('[TRACE] Entering ProcessData');
  {$ENDIF}
end;

uses
  System.SysUtils, System.Classes;

// Pattern 1: Retry with backoff
function DownloadWithRetry(const URL: string; MaxRetries: Integer): string;
var
  Attempt: Integer;
  Done: Boolean;
begin
  Attempt := 0;
  Done := False;
  while (not Done) and (Attempt < MaxRetries) do
  begin
    Inc(Attempt);
    try
      Result := DoDownload(URL);   // may raise EDownloadError
      Done := True;
    except
      on E: Exception do
      begin
        if Attempt >= MaxRetries then
          raise;   // re-raise after final attempt
        Sleep(Attempt * 500);   // exponential-ish backoff
      end;
    end;
  end;
end;

// Pattern 2: Fallback / default value
function SafeReadInt(const SL: TStringList; const Key: string; Default: Integer): Integer;
begin
  try
    Result := StrToInt(SL.Values[Key]);
  except
    on EConvertError do
      Result := Default;   // swallow and use default
  end;
end;

// Pattern 3: Resource protection (always Free)
procedure ProcessFile(const Path: string);
var
  SL: TStringList;
begin
  SL := TStringList.Create;
  try
    SL.LoadFromFile(Path);
    Transform(SL);
    SL.SaveToFile(Path + '.bak');
  finally
    SL.Free;   // guaranteed cleanup
  end;
end;

// Pattern 4: Acquire multiple resources safely
procedure CopyFile(const Src, Dst: string);
var
  SrcList, DstList: TStringList;
begin
  SrcList := TStringList.Create;
  try
    SrcList.LoadFromFile(Src);
    DstList := TStringList.Create;
    try
      DstList.Assign(SrcList);
      DstList.SaveToFile(Dst);
    finally
      DstList.Free;
    end;
  finally
    SrcList.Free;
  end;
end;

// Pattern 5: Validation with multiple checks
procedure ValidateUser(const Name: string; Age: Integer);
begin
  if Name = '' then
    raise EArgumentException.Create('Name required');
  if Length(Name) > 50 then
    raise EArgumentException.Create('Name too long');
  if (Age < 0) or (Age > 150) then
    raise ERangeError.CreateFmt('Invalid age: %d', [Age]);
end;

uses
  System.SysUtils, System.Classes, System.IOUtils, System.SyncObjs;

type
  TLogLevel = (llDebug, llInfo, llWarning, llError, llFatal);

  TLogger = class
  private
    FLock: TCriticalSection;
    FFile: TextFile;
    FMinLevel: TLogLevel;
    function LevelToStr(L: TLogLevel): string;
  public
    constructor Create(const LogPath: string; MinLevel: TLogLevel);
    destructor Destroy; override;
    procedure Log(Level: TLogLevel; const Msg: string); overload;
    procedure Log(Level: TLogLevel; const Fmt: string; const Args: array of const); overload;
    procedure LogException(E: Exception; const Context: string);
  end;

constructor TLogger.Create(const LogPath: string; MinLevel: TLogLevel);
begin
  FLock := TCriticalSection.Create;
  FMinLevel := MinLevel;
  AssignFile(FFile, LogPath);
  if FileExists(LogPath) then
    Append(FFile)
  else
    Rewrite(FFile);
end;

destructor TLogger.Destroy;
begin
  CloseFile(FFile);
  FLock.Free;
  inherited;
end;

function TLogger.LevelToStr(L: TLogLevel): string;
begin
  case L of
    llDebug:   Result := 'DEBUG';
    llInfo:    Result := 'INFO';
    llWarning: Result := 'WARN';
    llError:   Result := 'ERROR';
    llFatal:   Result := 'FATAL';
  end;
end;

procedure TLogger.Log(Level: TLogLevel; const Msg: string);
begin
  if Level < FMinLevel then Exit;
  FLock.Enter;
  try
    WriteLn(FFile, Format('%s [%s] %s', [DateTimeToStr(Now), LevelToStr(Level), Msg]));
    Flush(FFile);   // ensure written to disk
  finally
    FLock.Leave;
  end;
end;

procedure TLogger.Log(Level: TLogLevel; const Fmt: string; const Args: array of const);
begin
  Log(Level, Format(Fmt, Args));
end;

procedure TLogger.LogException(E: Exception; const Context: string);
begin
  Log(llError, '%s: %s: %s', [Context, E.ClassName, E.Message]);
end;

// Usage
var
  Logger: TLogger;
begin
  Logger := TLogger.Create('app.log', llInfo);
  try
    Logger.Log(llInfo, 'Application started');
    try
      RiskyOperation;
    except
      on E: Exception do
      begin
        Logger.LogException(E, 'RiskyOperation');
        raise;   // log and re-raise
      end;
    end;
  finally
    Logger.Free;
  end;
end;

uses
  System.SysUtils, System.Classes, System.IOUtils;

// LEGACY: AssignFile / ReadLn / WriteLn (Pascal-style)
var
  F: TextFile;
  Line: string;
begin
  // write
  AssignFile(F, 'output.txt');
  Rewrite(F);                // create/overwrite
  try
    WriteLn(F, 'Hello, File!');
    WriteLn(F, 'Second line');
  finally
    CloseFile(F);
  end;

  // append
  AssignFile(F, 'output.txt');
  Append(F);
  try
    WriteLn(F, 'Appended line');
  finally
    CloseFile(F);
  end;

  // read line by line
  AssignFile(F, 'output.txt');
  Reset(F);                  // open for reading
  try
    while not EOF(F) do
    begin
      ReadLn(F, Line);
      WriteLn(Line);
    end;
  finally
    CloseFile(F);
  end;
end;

// MODERN: TFile (System.IOUtils)
var
  Content: string;
  Lines: TArray<string>;
begin
  // write all text
  TFile.WriteAllText('output.txt', 'Hello, World!');

  // append
  TFile.AppendAllText('log.txt', 'New entry' + sLineBreak);

  // read all text
  Content := TFile.ReadAllText('output.txt');

  // read all lines
  Lines := TFile.ReadAllLines('data.csv');
  for Line in Lines do
    WriteLn(Line);

  // write all lines
  TFile.WriteAllLines('nums.txt', ['one', 'two', 'three']);

  // file exists?
  if TFile.Exists('data.txt') then
    WriteLn('Found');
end;

uses
  System.Classes;

var
  SL: TStringList;
  i: Integer;
begin
  SL := TStringList.Create;
  try
    // load a text file (one line per item)
    SL.LoadFromFile('data.txt');

    // iterate lines
    for i := 0 to SL.Count - 1 do
      WriteLn(SL[i]);

    // add and save
    SL.Add('New line');
    SL.SaveToFile('output.txt');

    // CSV handling (CommaText)
    SL.Clear;
    SL.CommaText := 'Alice,30,NYC';
    WriteLn(SL[0]);   // Alice
    WriteLn(SL[1]);   // 30
    WriteLn(SL[2]);   // NYC

    // custom delimiter
    SL.Clear;
    SL.Delimiter := '|';
    SL.DelimitedText := 'a|b|c';

    // key=value pairs (INI-style)
    SL.Clear;
    SL.Values['name'] := 'Alice';
    SL.Values['age'] := '30';
    WriteLn(SL.Values['name']);   // Alice
    SL.SaveToFile('config.ini');

    // sorted list (auto-sorts on Add)
    SL.Clear;
    SL.Sorted := True;
    SL.Add('cherry');
    SL.Add('apple');
    SL.Add('banana');
    // SL is now: apple, banana, cherry

    // find (binary search — list must be sorted)
    if SL.Find('banana', i) then
      WriteLn('Found at ', i);

    // duplicate handling
    SL.Duplicates := dupIgnore;   // ignore duplicates (sorted only)
    SL.Duplicates := dupError;    // raise on duplicates
  finally
    SL.Free;
  end;
end;

uses
  System.Classes, System.SysUtils;

var
  FS: TFileStream;
  BR: TBinaryReader;
  BW: TBinaryWriter;
  SR: TStreamReader;
  SW: TStreamWriter;
  Buffer: TBytes;
  i: Integer;
begin
  // TFileStream: low-level file access
  FS := TFileStream.Create('data.bin', fmCreate);   // fmCreate, fmOpenRead, fmOpenWrite
  try
    // write bytes
    SetLength(Buffer, 4);
    Buffer[0] := 1; Buffer[1] := 2; Buffer[2] := 3; Buffer[3] := 4;
    FS.Write(Buffer[0], Length(Buffer));

    // read
    FS.Position := 0;   // rewind
    SetLength(Buffer, 4);
    FS.Read(Buffer[0], 4);
  finally
    FS.Free;
  end;

  // TBinaryWriter / TBinaryReader (typed binary I/O)
  BW := TBinaryWriter.Create('data.bin');
  try
    BW.Write(42);          // Integer
    BW.Write(3.14);        // Double
    BW.Write('Hello');     // length-prefixed string
    BW.Write(True);        // Boolean
  finally
    BW.Free;
  end;

  BR := TBinaryReader.Create('data.bin');
  try
    WriteLn(BR.ReadInt32);    // 42
    WriteLn(BR.ReadDouble);   // 3.14
    WriteLn(BR.ReadString);   // Hello
    WriteLn(BR.ReadBoolean);  // TRUE
  finally
    BR.Free;
  end;

  // TStreamReader / TStreamWriter (text, with encoding)
  SW := TStreamWriter.Create('utf8.txt', False, TEncoding.UTF8);
  try
    SW.WriteLine('Hello, UTF-8!');
    SW.WriteLine('héllo wörld');
  finally
    SW.Free;
  end;

  SR := TStreamReader.Create('utf8.txt', TEncoding.UTF8);
  try
    while not SR.EndOfStream do
      WriteLn(SR.ReadLine);
  finally
    SR.Free;
  end;
end;

uses
  System.IOUtils, System.SysUtils;

var
  Files: TArray<string>;
  Dirs: TArray<string>;
  Path: string;
  i: Integer;
begin
  // TPath (cross-platform path handling)
  Path := TPath.Combine('folder', 'sub', 'file.txt');  // folder/sub/file.txt
  WriteLn(TPath.GetFileName('C:\temp\data.txt'));     // data.txt
  WriteLn(TPath.GetExtension('photo.JPG'));             // .JPG
  WriteLn(TPath.GetFileNameWithoutExtension('data.txt')); // data
  WriteLn(TPath.GetDirectoryName('C:\temp\data.txt'));  // C:\temp
  WriteLn(TPath.GetFullPath('data.txt'));               // absolute path

  // temp files
  WriteLn(TPath.GetTempFileName);   // creates a temp file
  WriteLn(TPath.GetTempPath);       // temp directory

  // special folders
  WriteLn(TPath.GetDocumentsPath);
  WriteLn(TPath.GetHomePath);

  // TDirectory
  TDirectory.CreateDirectory('backup\2024\june');

  Files := TDirectory.GetFiles('C:\temp', '*.txt');
  for i := 0 to High(Files) do
    WriteLn(Files[i]);

  // recursive search
  Files := TDirectory.GetFiles('C:\temp', '*.*', TSearchOption.soAllDirectories);

  Dirs := TDirectory.GetDirectories('C:\temp');
  for i := 0 to High(Dirs) do
    WriteLn(Dirs[i]);

  if TDirectory.Exists('old') then
    TDirectory.Delete('old', True);   // recursive delete

  // TFile operations
  TFile.Copy('source.txt', 'dest.txt', True);   // overwrite
  TFile.Move('old.txt', 'new.txt');
  TFile.Delete('unwanted.txt');

  // file info
  var Info: TFileInfo := TFileInfo.Create('data.txt');
  try
    WriteLn(Info.Length);          // size in bytes
    WriteLn(Info.CreationTime);
    WriteLn(Info.LastWriteTime);
    WriteLn(Info.Extension);
  finally
    Info.Free;
  end;
end;

uses
  System.IniFiles, System.JSON, System.SysUtils;

// INI files (simple config)
var
  Ini: TIniFile;
begin
  Ini := TIniFile.Create('config.ini');
  try
    // write
    Ini.WriteString('User', 'Name', 'Alice');
    Ini.WriteInteger('User', 'Age', 30);
    Ini.WriteBool('User', 'Active', True);
    Ini.WriteDateTime('Session', 'LastLogin', Now);

    // read (with defaults)
    WriteLn(Ini.ReadString('User', 'Name', 'Unknown'));   // Alice
    WriteLn(Ini.ReadInteger('User', 'Age', 0));            // 30
    WriteLn(Ini.ReadBool('User', 'Active', False));        // TRUE

    // read a whole section
    var SL: TStringList;
    SL := TStringList.Create;
    try
      Ini.ReadSection('User', SL);
      // SL = ['Name', 'Age', 'Active']
    finally
      SL.Free;
    end;
  finally
    Ini.Free;
  end;
end;

// JSON (System.JSON)
var
  Obj: TJSONObject;
  Arr: TJSONArray;
  JSON: string;
  i: Integer;
begin
  // build JSON
  Obj := TJSONObject.Create;
  try
    Obj.AddPair('name', 'Alice');
    Obj.AddPair('age', TJSONNumber.Create(30));
    Obj.AddPair('active', TJSONBool.Create(True));

    var Hobbies := TJSONArray.Create;
    Hobbies.Add('reading').Add('coding');
    Obj.AddPair('hobbies', Hobbies);

    JSON := Obj.ToJSON;
    // {"name":"Alice","age":30,"active":true,"hobbies":["reading","coding"]}
  finally
    Obj.Free;
  end;

  // parse JSON
  Obj := TJSONObject.ParseJSONValue(JSON) as TJSONObject;
  try
    WriteLn(Obj.GetValue<string>('name'));        // Alice
    WriteLn(Obj.GetValue<Integer>('age'));         // 30
    Arr := Obj.GetValue<TJSONArray>('hobbies');
    for i := 0 to Arr.Count - 1 do
      WriteLn(Arr.Items[i].Value);                 // reading, coding
  finally
    Obj.Free;
  end;
end;

type
  TMainForm = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    FData: TStringList;
  public
    property Data: TStringList read FData;
  end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FData := TStringList.Create;     // allocate in OnCreate
  Caption := 'My App v1.0';
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  Edit1.SetFocus;                  // focus when form is visible
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := MessageDlg('Close?', mtConfirmation, [mbYes, mbNo], 0) = mrYes;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FData.Free;                      // free in OnDestroy (pairs with OnCreate)
end;

// Edit, Memo, Label, Button, CheckBox, RadioButton
Edit1.Text := 'Hello';
Edit1.MaxLength := 50;
Edit1.PasswordChar := '*';         // mask input

Memo1.Lines.Add('Line 1');         // TStrings collection
Memo1.Lines.LoadFromFile('notes.txt');
Memo1.WordWrap := True;
Memo1.ScrollBars := ssVertical;

// ComboBox & ListBox
ComboBox1.Items.Add('Option A');
ComboBox1.ItemIndex := 0;          // select first
ComboBox1.Style := csDropDownList; // read-only selection

ListBox1.Items.Add('Item 1');
ListBox1.Sorted := True;
ShowMessage(ListBox1.Items[ListBox1.ItemIndex]);

// CheckBox & RadioButton
if CheckBox1.Checked then
  ShowMessage('Checked');
RadioGroup1.Items.Add('Red');
RadioGroup1.Items.Add('Green');
RadioGroup1.ItemIndex := 0;

// TStringGrid - spreadsheet-like grid
StringGrid1.RowCount := 5;
StringGrid1.ColCount := 4;
StringGrid1.FixedRows := 1;        // header row
StringGrid1.FixedCols := 0;

// set headers
StringGrid1.Cells[0, 0] := 'Name';
StringGrid1.Cells[1, 0] := 'Age';
StringGrid1.Cells[2, 0] := 'City';

// populate data
StringGrid1.Cells[0, 1] := 'Alice';
StringGrid1.Cells[1, 1] := '30';
StringGrid1.Cells[2, 1] := 'NYC';

// customize appearance
StringGrid1.ColWidths[0] := 120;
StringGrid1.RowHeights[0] := 30;
StringGrid1.Options := StringGrid1.Options + [goEditing, goColSizing];

// onDrawCell for custom rendering
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  if ARow = 0 then
    StringGrid1.Canvas.Font.Style := [fsBold];
  StringGrid1.Canvas.TextRect(Rect, Rect.Left + 4, Rect.Top + 2,
    StringGrid1.Cells[ACol, ARow]);
end;

// TTreeView - hierarchical data
var
  RootNode, ChildNode: TTreeNode;
begin
  TreeView1.Items.BeginUpdate;
  try
    TreeView1.Items.Clear;
    RootNode := TreeView1.Items.Add(nil, 'Root');
    ChildNode := TreeView1.Items.AddChild(RootNode, 'Child 1');
    TreeView1.Items.AddChild(RootNode, 'Child 2');
    TreeView1.Items.AddChild(ChildNode, 'Grandchild');
    RootNode.Expand(True);         // expand all children
  finally
    TreeView1.Items.EndUpdate;
  end;

  // iterate
  var Node := TreeView1.Items.GetFirstNode;
  while Node <> nil do
  begin
    ShowMessage(Node.Text);
    Node := Node.GetNext;          // depth-first traversal
  end;
end;

// TListView - report view with columns
ListView1.ViewStyle := vsReport;
ListView1.Columns.Add.Caption := 'Name';
ListView1.Columns.Add.Caption := 'Size';
var Item := ListView1.Items.Add;
Item.Caption := 'file.txt';
Item.SubItems.Add('1.2 KB');

// File dialogs
if OpenDialog1.Execute then
  ShowMessage('Selected: ' + OpenDialog1.FileName);

if SaveDialog1.Execute then
  ShowMessage('Save to: ' + SaveDialog1.FileName);

OpenDialog1.Filter := 'Text files (*.txt)|*.txt|All files (*.*)|*.*';
OpenDialog1.DefaultExt := 'txt';
OpenDialog1.Options := [ofFileMustExist, ofAllowMultiSelect];

// Color & Font dialogs
if ColorDialog1.Execute then
  Panel1.Color := ColorDialog1.Color;

if FontDialog1.Execute then
  Label1.Font := FontDialog1.Font;

// Message dialogs
case MessageDlg('Delete file?', mtWarning, [mbYes, mbNo, mbCancel], 0) of
  mrYes: DeleteFile('temp.txt');
  mrNo: ShowMessage('Cancelled');
end;

// InputBox & InputQuery
var Name := InputBox('Login', 'Enter name:', 'guest');
var Value: string;
if InputQuery('Settings', 'Port:', Value) then
  ShowMessage('Port: ' + Value);

// TPageControl (tabs)
var TabSheet := TTabSheet.Create(PageControl1);
TabSheet.PageControl := PageControl1;
TabSheet.Caption := 'Tab 1';

// Event type declaration
type
  TNotifyEvent = procedure(Sender: TObject) of object;
  TKeyPressEvent = procedure(Sender: TObject; var Key: Char) of object;

  TCounter = class
  private
    FValue: Integer;
    FOnChange: TNotifyEvent;
    FOnThresholdReached: TThresholdEvent;
  public
    property Value: Integer read FValue write SetValue;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

procedure TCounter.SetValue(const NewValue: Integer);
begin
  if FValue <> NewValue then
  begin
    FValue := NewValue;
    if Assigned(FOnChange) then       // check before calling
      FOnChange(Self);                // trigger event
  end;
end;

// assigning handler at runtime
Counter1.OnChange := CounterChangeHandler;

procedure TForm1.CounterChangeHandler(Sender: TObject);
begin
  Label1.Caption := 'Value: ' + IntToStr((Sender as TCounter).Value);
end;

type
  TMathFunc = function(X, Y: Integer): Integer of object;

  TCalculator = class
    function Add(X, Y: Integer): Integer;
    function Subtract(X, Y: Integer): Integer;
    function Multiply(X, Y: Integer): Integer;
  end;

function TCalculator.Add(X, Y: Integer): Integer;
begin
  Result := X + Y;
end;

// store and invoke method reference
var
  Calc: TCalculator;
  Op: TMathFunc;
begin
  Calc := TCalculator.Create;
  try
    Op := Calc.Add;           // method pointer
    ShowMessage(IntToStr(Op(10, 20)));  // 30

    Op := Calc.Subtract;
    ShowMessage(IntToStr(Op(10, 20)));  // -10
  finally
    Calc.Free;
  end;
end;

// regular procedure pointers (not of object)
type
  TSimpleFunc = function(X: Integer): Integer;
function DoubleIt(X: Integer): Integer;
begin
  Result := X * 2;
end;
var F: TSimpleFunc := DoubleIt;

type
  TFuncInt = reference to function(X: Integer): Integer;
  TProcStr = reference to procedure(const S: string);

procedure Apply(const Func: TFuncInt; Values: array of Integer);
var
  I: Integer;
begin
  for I := 0 to High(Values) do
    WriteLn(Func(Values[I]));
end;

var
  Multiplier: Integer;
  Double: TFuncInt;
begin
  Multiplier := 2;
  // anonymous method captures Multiplier (closure)
  Double := function(X: Integer): Integer
    begin
      Result := X * Multiplier;
    end;

  Apply(Double, [1, 2, 3, 4, 5]);   // 2, 4, 6, 8, 10

  Multiplier := 3;
  Apply(Double, [1, 2, 3]);          // 3, 6, 9 (captures by reference!)

  // anonymous procedure
  var Log: TProcStr := procedure(const S: string)
    begin
      WriteLn('[LOG] ' + S);
    end;
  Log('Hello');
end;

type
  TMyForm = class(TForm)
  private
    procedure WMMouseDown(var Msg: TWMMouse); message WM_LBUTTONDOWN;
    procedure WMKeyDown(var Msg: TWMKeyDown); message WM_KEYDOWN;
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
  protected
    procedure WndProc(var Message: TMessage); override;
  end;

// handle specific Windows message
procedure TMyForm.WMMouseDown(var Msg: TWMMouse);
begin
  inherited;                       // call default handler
  ShowMessage(Format('Click at %d, %d', [Msg.XPos, Msg.YPos]));
end;

// intercept all messages
procedure TMyForm.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_CLOSE then
  begin
    if MessageDlg('Close?', mtConfirmation, [mbYes, mbNo], 0) = mrNo then
      Exit;                       // swallow the message
  end;
  inherited WndProc(Message);     // pass to default
end;

// post/send custom messages
const
  WM_MYMESSAGE = WM_USER + 100;

PostMessage(Handle, WM_MYMESSAGE, 0, 0);   // async, returns immediately
SendMessage(Handle, WM_MYMESSAGE, 0, 0);   // sync, waits for handler

type
  TForm1 = class(TForm)
    ApplicationEvents1: TApplicationEvents;
    procedure AppIdle(Sender: TObject; var Done: Boolean);
    procedure AppException(Sender: TObject; E: Exception);
    procedure AppMinimize(Sender: TObject);
  end;

// OnIdle - runs when app has no pending messages
procedure TForm1.AppIdle(Sender: TObject; var Done: Boolean);
begin
  Label1.Caption := 'Idle...';
  Done := True;                    // False = keep calling Idle
end;

// global exception handler
procedure TForm1.AppException(Sender: TObject; E: Exception);
begin
  LogError(E.Message);
  ShowMessage('Error: ' + E.Message);
end;

// TTimer - periodic events
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  StatusBar1.Panels[0].Text := TimeToStr(Now);
end;

// TThread.Queue / TThread.Synchronize - marshal to main thread
TThread.Queue(nil,
  procedure
  begin
    Label1.Caption := 'Updated from background';
  end);

// ProcessMessages - pump message queue
while LongOperationRunning do
begin
  DoChunk;
  Application.ProcessMessages;     // keep UI responsive
end;

uses
  FireDAC.Comp.Client, FireDAC.Comp.DataSet, FireDAC.Stan.Param;

var
  FDConn: TFDConnection;
  Query: TFDQuery;
begin
  FDConn := TFDConnection.Create(nil);
  Query := TFDQuery.Create(nil);
  try
    // connection string (SQLite example)
    FDConn.DriverName := 'SQLite';
    FDConn.Params.Database := 'app.db';
    FDConn.Connected := True;

    Query.Connection := FDConn;

    // execute non-query (DDL/DML)
    Query.ExecSQL('CREATE TABLE IF NOT EXISTS users ' +
      '(id INTEGER PRIMARY KEY, name TEXT, age INTEGER)');

    // parameterized insert (prevents SQL injection)
    Query.SQL.Text := 'INSERT INTO users (name, age) VALUES (:name, :age)';
    Query.ParamByName('name').AsString := 'Alice';
    Query.ParamByName('age').AsInteger := 30;
    Query.ExecSQL;

    // select with parameters
    Query.SQL.Text := 'SELECT * FROM users WHERE age > :minAge';
    Query.ParamByName('minAge').AsInteger := 18;
    Query.Open;

    while not Query.Eof do
    begin
      ShowMessage(Query.FieldByName('name').AsString);
      Query.Next;
    end;
  finally
    Query.Free;
    FDConn.Free;
  end;
end;

var
  Table: TFDTable;
begin
  Table := TFDTable.Create(nil);
  try
    Table.Connection := FDConn;
    Table.TableName := 'users';
    Table.Open;                    // SELECT * FROM users

    // navigate
    Table.First;
    while not Table.Eof do
    begin
      ShowMessage(Table.FieldByName('name').AsString);
      Table.Next;
    end;

    // locate a record
    if Table.Locate('name', 'Alice', []) then
      ShowMessage('Found Alice');

    // edit/insert/post
    Table.Append;                  // or Insert / Edit
    Table.FieldByName('name').AsString := 'Bob';
    Table.FieldByName('age').AsInteger := 25;
    Table.Post;                    // commit to dataset

    // filter
    Table.Filter := 'age > 20';
    Table.Filtered := True;

    // index for sorting
    Table.IndexFieldNames := 'name';
  finally
    Table.Free;
  end;
end;

// connect to DBGrid via DataSource
DataSource1.DataSet := Table;
DBGrid1.DataSource := DataSource1;

var
  FDConn: TFDConnection;
  Query: TFDQuery;
  I: Integer;
begin
  FDConn := TFDConnection.Create(nil);
  Query := TFDQuery.Create(nil);
  try
    FDConn.DriverName := 'SQLite';
    FDConn.Params.Database := 'app.db';
    FDConn.Connected := True;
    Query.Connection := FDConn;

    // explicit transaction
    FDConn.StartTransaction;
    try
      Query.SQL.Text := 'INSERT INTO users (name, age) VALUES (:n, :a)';
      for I := 1 to 1000 do
      begin
        Query.ParamByName('n').AsString := 'User' + IntToStr(I);
        Query.ParamByName('a').AsInteger := 20 + (I mod 50);
        Query.ExecSQL;
      end;
      FDConn.Commit;               // commit all
    except
      FDConn.Rollback;             // undo all on error
      raise;
    end;

    // batch execute (Array DML - very fast)
    Query.SQL.Text := 'INSERT INTO logs (msg) VALUES (:m)';
    Query.Params.ArraySize := 100;
    for I := 0 to 99 do
      Query.Params[0].AsStrings[I] := 'Log entry ' + IntToStr(I);
    Query.Execute(100, 0);         // execute 100 times at once
  finally
    Query.Free;
    FDConn.Free;
  end;
end;

// call stored procedure
var
  SP: TFDStoredProc;
begin
  SP := TFDStoredProc.Create(nil);
  try
    SP.Connection := FDConn;
    SP.StoredProcName := 'get_user_by_id';
    SP.Params.ParamByName('@user_id').AsInteger := 42;

    // output parameter
    SP.Params.ParamByName('@name').ParamType := ptOutput;

    SP.ExecProc;                   // execute (no cursor)
    ShowMessage(SP.ParamByName('@name').AsString);

    // or Open if it returns a result set
    SP.Open;
    ShowMessage(SP.FieldByName('name').AsString);
  finally
    SP.Free;
  end;
end;

// metadata - list tables
var
  Meta: TFDMetaInfoQuery;
begin
  Meta := TFDMetaInfoQuery.Create(nil);
  try
    Meta.Connection := FDConn;
    Meta.MetaInfoKind := mkTables;     // or mkColumns, mkIndexes
    Meta.Open;
    while not Meta.Eof do
    begin
      ShowMessage(Meta.FieldByName('TABLE_NAME').AsString);
      Meta.Next;
    end;
  finally
    Meta.Free;
  end;
end;

uses FireDAC.Comp.Client, FireDAC.Stan.Intf;

var
  MemTable: TFDMemTable;
begin
  MemTable := TFDMemTable.Create(nil);
  try
    // define schema in code
    MemTable.FieldDefs.Add('id', ftInteger);
    MemTable.FieldDefs.Add('name', ftString, 50);
    MemTable.FieldDefs.Add('salary', ftCurrency);
    MemTable.CreateDataSet;        // create in-memory table

    // populate
    MemTable.AppendRecord([1, 'Alice', 75000]);
    MemTable.AppendRecord([2, 'Bob', 68000]);
    MemTable.AppendRecord([3, 'Carol', 82000]);

    // index & filter
    MemTable.IndexFieldNames := 'salary';
    MemTable.Filter := 'salary > 70000';
    MemTable.Filtered := True;

    // Local SQL - query any TDataSet with SQL
    var LocalSQL := TFDLocalSQL.Create(nil);
    try
      LocalSQL.Connection := FDConn;  // or a dedicated connection
      LocalSQL.DataSets.AddDataSet(MemTable, 'employees');
      LocalSQL.Active := True;

      var Q := TFDQuery.Create(nil);
      try
        Q.Connection := FDConn;
        Q.Open('SELECT * FROM employees WHERE salary > :min ORDER BY name');
        // query in-memory data with full SQL!
      finally
        Q.Free;
      end;
    finally
      LocalSQL.Free;
    end;
  finally
    MemTable.Free;
  end;
end;

type
  TStack<T> = class
  private
    FItems: array of T;
    FCount: Integer;
  public
    procedure Push(const Value: T);
    function Pop: T;
    function Peek: T;
    function Count: Integer;
  end;

procedure TStack<T>.Push(const Value: T);
begin
  if FCount = Length(FItems) then
    SetLength(FItems, FCount * 2 + 4);
  FItems[FCount] := Value;
  Inc(FCount);
end;

function TStack<T>.Pop: T;
begin
  if FCount = 0 then
    raise Exception.Create('Stack empty');
  Dec(FCount);
  Result := FItems[FCount];
end;

// usage - type-safe, no casts
var
  IntStack: TStack<Integer>;
  StrStack: TStack<string>;
begin
  IntStack := TStack<Integer>.Create;
  IntStack.Push(42);
  IntStack.Push(99);
  ShowMessage(IntToStr(IntStack.Pop));  // 99

  StrStack := TStack<string>.Create;
  StrStack.Push('Hello');
  ShowMessage(StrStack.Pop);             // Hello
end;

type
  // T must be a class
  TRepository<T: class> = class
    function Find(Id: Integer): T;
  end;

  // T must be a class with a parameterless constructor
  TFactory<T: class, constructor> = class
    function CreateInstance: T;
  end;

  // T must implement IComparable
  TSorter<T: IComparable> = class
    procedure Sort(var Arr: array of T);
  end;

  // multiple constraints
  TManager<T: class, constructor, IComparable> = class
  end;

function TFactory<T>.CreateInstance: T;
begin
  Result := T.Create;    // allowed because of 'constructor' constraint
end;

// type inference
type
  TPair<TKey, TValue> = class
    Key: TKey;
    Value: TValue;
    constructor Create(const K: TKey; const V: TValue);
  end;

var
  P: TPair<string, Integer>;
begin
  P := TPair<string, Integer>.Create('age', 30);
end;

uses System.Generics.Collections, System.Generics.Defaults;

var
  List: TList<Integer>;
  Dict: TDictionary<string, Integer>;
  ObjList: TObjectList<TPerson>;
begin
  // TList<T>
  List := TList<Integer>.Create;
  try
    List.AddRange([3, 1, 4, 1, 5, 9, 2, 6]);
    List.Sort;                     // 1, 1, 2, 3, 4, 5, 6, 9
    List.BinarySearch(5, var Idx); // fast lookup in sorted list

    // custom comparer
    List.Sort(TComparer<Integer>.Construct(
      function(const L, R: Integer): Integer
      begin
        Result := R - L;           // descending
      end));

    // find with predicate
    var Found := List.FindIndex(
      function(const X: Integer): Boolean
      begin
        Result := X > 4;
      end);
  finally
    List.Free;
  end;

  // TDictionary
  Dict := TDictionary<string, Integer>.Create;
  try
    Dict.Add('apple', 5);
    Dict.Add('banana', 3);
    Dict.AddOrSetValue('apple', 10);  // update or insert

    if Dict.TryGetValue('banana', var Count) then
      ShowMessage(Count.ToString);

    // iterate
    for var Pair in Dict do
      ShowMessage(Pair.Key + ': ' + Pair.Value.ToString);
  finally
    Dict.Free;
  end;
end;

uses System.SysUtils;

type
  TFunc<T, TResult> = reference to function(Arg: T): TResult;
  TProc<T> = reference to procedure(Arg: T);

// higher-order functions
function Map<T, TResult>(const Source: array of T;
  const Mapper: TFunc<T, TResult>): TArray<TResult>;
var
  I: Integer;
begin
  SetLength(Result, Length(Source));
  for I := 0 to High(Source) do
    Result[I] := Mapper(Source[I]);
end;

function Filter<T>(const Source: array of T;
  const Predicate: TFunc<T, Boolean>): TArray<T>;
var
  I, Count: Integer;
begin
  Count := 0;
  SetLength(Result, Length(Source));
  for I := 0 to High(Source) do
    if Predicate(Source[I]) then
    begin
      Result[Count] := Source[I];
      Inc(Count);
    end;
  SetLength(Result, Count);
end;

// usage with closures
var
  Numbers: array of Integer;
  Doubled, Evens: TArray<Integer>;
  Threshold: Integer;
begin
  Numbers := [1, 2, 3, 4, 5, 6, 7, 8, 9, 10];
  Threshold := 5;

  Doubled := Map<Integer, Integer>(Numbers,
    function(X: Integer): Integer
    begin
      Result := X * 2;
    end);

  // closure captures Threshold
  Evens := Filter<Integer>(Numbers,
    function(X: Integer): Boolean
    begin
      Result := (X > Threshold) and (X mod 2 = 0);
    end);
end;

type
  IComparable<T> = interface
    function CompareTo(const Other: T): Integer;
  end;

  IRepository<T> = interface
    function GetById(Id: Integer): T;
    function GetAll: TArray<T>;
    procedure Save(const Entity: T);
    procedure Delete(Id: Integer);
  end;

  TMemoryRepository<T: class, constructor> = class(TInterfacedObject, IRepository<T>)
  private
    FItems: TList<T>;
  public
    constructor Create;
    destructor Destroy; override;
    function GetById(Id: Integer): T;
    function GetAll: TArray<T>;
    procedure Save(const Entity: T);
    procedure Delete(Id: Integer);
  end;

// custom comparer for sorting objects
type
  TPerson = class
    Name: string;
    Age: Integer;
  end;

var
  People: TObjectList<TPerson>;
begin
  People := TObjectList<TPerson>.Create;
  People.Sort(TComparer<TPerson>.Construct(
    function(const L, R: TPerson): Integer
    begin
      Result := CompareText(L.Name, R.Name);  // sort by name
    end));
end;

uses System.RTTI, System.TypInfo;

type
  TPerson = class
  private
    FName: string;
    FAge: Integer;
  published
    property Name: string read FName write FName;
    property Age: Integer read FAge write FAge;
  end;

var
  Ctx: TRTTIContext;
  RType: TRttiType;
  Prop: TRttiProperty;
  Person: TPerson;
begin
  Person := TPerson.Create;
  try
    Person.Name := 'Alice';
    Person.Age := 30;

    Ctx := TRTTIContext.Create;
    try
      RType := Ctx.GetType(TPerson);

      // enumerate properties
      for Prop in RType.GetProperties do
      begin
        WriteLn(Prop.Name, ': ', Prop.PropertyType.Name);

        // read value
        if Prop.IsReadable then
          WriteLn('  Value: ', Prop.GetValue(Person).ToString);

        // write value
        if Prop.IsWritable then
          Prop.SetValue(Person, TValue.From<string>('Bob'));
      end;

      // get specific property
      Prop := RType.GetProperty('Name');
      ShowMessage(Prop.GetValue(Person).AsString);
    finally
      Ctx.Free;
    end;
  finally
    Person.Free;
  end;
end;

uses System.RTTI;

type
  TValidatorAttribute = class(TCustomAttribute)
  private
    FMaxLen: Integer;
  public
    constructor Create(MaxLen: Integer);
    property MaxLen: Integer read FMaxLen;
  end;

  TUser = class
  private
    FName: string;
  public
    [Validator(50)]
    property Name: string read FName write FName;

    function Greet(const Greeting: string): string;
  end;

constructor TValidatorAttribute.Create(MaxLen: Integer);
begin
  FMaxLen := MaxLen;
end;

var
  Ctx: TRTTIContext;
  RType: TRttiType;
  Prop: TRttiProperty;
  Attr: TCustomAttribute;
  Method: TRttiMethod;
  User: TUser;
  Result: TValue;
begin
  User := TUser.Create;
  User.Name := 'Alice';
  Ctx := TRTTIContext.Create;
  try
    RType := Ctx.GetType(TUser);

    // read attributes
    Prop := RType.GetProperty('Name');
    for Attr in Prop.GetAttributes do
    begin
      if Attr is TValidatorAttribute then
        WriteLn('Max length: ', TValidatorAttribute(Attr).MaxLen);
    end;

    // invoke method by name
    Method := RType.GetMethod('Greet');
    Result := Method.Invoke(User, ['Hello']);
    ShowMessage(Result.AsString);  // Hello, Alice
  finally
    Ctx.Free;
    User.Free;
  end;
end;

uses System.RTTI;

var
  Ctx: TRTTIContext;
  Types: TArray<TRttiType>;
  T: TRttiType;
  Field: TRttiField;
  Method: TRttiMethod;
begin
  Ctx := TRTTIContext.Create;
  try
    // enumerate ALL types in the program
    Types := Ctx.GetTypes;

    // find types by name
    T := Ctx.FindType('Unit1.TPerson');
    if T <> nil then
      ShowMessage('Found: ' + T.QualifiedName);

    // filter: all classes in a unit
    for T in Types do
    begin
      if (T.TypeKind = tkClass) and T.QualifiedName.StartsWith('MyApp.') then
      begin
        WriteLn('Class: ', T.Name);

        // enumerate fields
        for Field in T.GetFields do
          WriteLn('  Field: ', Field.Name, ': ', Field.FieldType.Name);

        // enumerate methods
        for Method in T.GetMethods do
          WriteLn('  Method: ', Method.Name,
            ' - ', Method.MethodType.ToString);
      end;
    end;

    // create instance via RTTI
    var Instance := T.AsInstance.MetaclassType.Create;
    try
      // use instance...
    finally
      Instance.Free;
    end;
  finally
    Ctx.Free;
  end;
end;

uses System.RTTI;

var
  V: TValue;
  I: Integer;
  S: string;
  D: Double;
  Obj: TObject;
begin
  // wrap values
  V := TValue.From<Integer>(42);
  ShowMessage(V.ToString);          // '42'
  I := V.AsInteger;                 // unwrap

  V := TValue.From<string>('Hello');
  S := V.AsString;

  // type checking
  if V.IsType<string> then
    ShowMessage('It is a string');

  // conversion
  V := TValue.From<Integer>(100);
  D := V.AsExtended;                // 100.0

  // boxing objects
  var Person := TPerson.Create;
  try
    V := TValue.From<TPerson>(Person);
    if V.IsObject then
      ShowMessage(V.AsObject.ClassName);  // 'TPerson'
  finally
    Person.Free;
  end;

  // array of TValue for method invocation
  var Args: array of TValue;
  SetLength(Args, 2);
  Args[0] := TValue.From<Integer>(10);
  Args[1] := TValue.From<Integer>(20);

  // try conversion
  V := TValue.From<string>('123');
  if V.TryAsType<Integer>(I) then
    ShowMessage(IntToStr(I));       // 123
end;

uses System.RTTI, System.JSON;

function ObjectToJSON(Obj: TObject): TJSONObject;
var
  Ctx: TRTTIContext;
  RType: TRttiType;
  Prop: TRttiProperty;
  Val: TValue;
begin
  Result := TJSONObject.Create;
  Ctx := TRTTIContext.Create;
  try
    RType := Ctx.GetType(Obj.ClassType);
    for Prop in RType.GetProperties do
    begin
      if not Prop.IsReadable then Continue;
      Val := Prop.GetValue(Obj);
      case Val.Kind of
        tkString, tkUString:
          Result.AddPair(Prop.Name, Val.AsString);
        tkInteger:
          Result.AddPair(Prop.Name, TJSONNumber.Create(Val.AsInteger));
        tkFloat:
          Result.AddPair(Prop.Name, TJSONNumber.Create(Val.AsExtended));
        tkEnumeration:
          Result.AddPair(Prop.Name, TJSONBool.Create(Val.AsBoolean));
      end;
    end;
  finally
    Ctx.Free;
  end;
end;

procedure JSONToObject(Obj: TObject; const JSON: TJSONObject);
var
  Ctx: TRTTIContext;
  RType: TRttiType;
  Prop: TRttiProperty;
  Pair: TJSONPair;
begin
  Ctx := TRTTIContext.Create;
  try
    RType := Ctx.GetType(Obj.ClassType);
    for Prop in RType.GetProperties do
    begin
      if not Prop.IsWritable then Continue;
      Pair := JSON.FindPair(Prop.Name);
      if Pair <> nil then
      begin
        case Prop.PropertyType.TypeKind of
          tkString, tkUString:
            Prop.SetValue(Obj, TValue.From<string>(Pair.JsonValue.Value));
          tkInteger:
            Prop.SetValue(Obj, TValue.From<Integer>((Pair.JsonValue as TJSONNumber).AsInt));
        end;
      end;
    end;
  finally
    Ctx.Free;
  end;
end;

type
  IMovable = interface
    ['{A1B2C3D4-E5F6-7890-ABCD-EF1234567890}']  // GUID (optional)
    procedure MoveTo(X, Y: Integer);
    function GetPosition: TPoint;
    property Position: TPoint read GetPosition;
  end;

  IDrawable = interface
    procedure Draw(Canvas: TCanvas);
  end;

  TShape = class(TInterfacedObject, IMovable, IDrawable)
  private
    FX, FY: Integer;
  public
    procedure MoveTo(X, Y: Integer);
    function GetPosition: TPoint;
    procedure Draw(Canvas: TCanvas);
  end;

procedure TShape.MoveTo(X, Y: Integer);
begin
  FX := X;
  FY := Y;
end;

// usage - reference counted automatically
var
  Shape: IMovable;
begin
  Shape := TShape.Create;          // ref count = 1
  Shape.MoveTo(100, 200);
  ShowMessage(Format('%d, %d', [Shape.Position.X, Shape.Position.Y]));
  // when Shape goes out of scope, ref count drops to 0, object freed
end;

type
  ILogger = interface
    procedure Log(const Msg: string);
  end;

  IUserDataAccess = interface
    function GetUser(Id: Integer): string;
  end;

  TConsoleLogger = class(TInterfacedObject, ILogger)
    procedure Log(const Msg: string);
  end;

  TDatabaseAccess = class(TInterfacedObject, IUserDataAccess)
    function GetUser(Id: Integer): string;
  end;

  TUserService = class
  private
    FLogger: ILogger;
    FDataAccess: IUserDataAccess;
  public
    constructor Create(ALogger: ILogger; ADataAccess: IUserDataAccess);
    function GetUserName(Id: Integer): string;
  end;

constructor TUserService.Create(ALogger: ILogger; ADataAccess: IUserDataAccess);
begin
  FLogger := ALogger;
  FDataAccess := ADataAccess;
end;

function TUserService.GetUserName(Id: Integer): string;
begin
  FLogger.Log('Fetching user ' + IntToStr(Id));
  Result := FDataAccess.GetUser(Id);
end;

// wire up dependencies (manual DI)
var
  Logger: ILogger;
  DataAccess: IUserDataAccess;
  Service: TUserService;
begin
  Logger := TConsoleLogger.Create;
  DataAccess := TDatabaseAccess.Create;
  Service := TUserService.Create(Logger, DataAccess);
  try
    ShowMessage(Service.GetUserName(42));
  finally
    Service.Free;    // TUserService is not ref-counted (not TInterfacedObject)
  end;
end;

uses
  Winapi.ActiveX, System.Win.ComObj;

// create COM object (e.g., Excel)
var
  Excel: Variant;
  Workbook: Variant;
  Sheet: Variant;
begin
  Excel := CreateOleObject('Excel.Application');
  try
    Excel.Visible := True;
    Workbook := Excel.Workbooks.Add;
    Sheet := Workbook.Worksheets[1];

    // write data
    Sheet.Cells[1, 1].Value := 'Name';
    Sheet.Cells[1, 2].Value := 'Score';
    Sheet.Cells[2, 1].Value := 'Alice';
    Sheet.Cells[2, 2].Value := 95;

    // formula
    Sheet.Cells[3, 2].Value := '=AVERAGE(B2:B2)';

    Workbook.SaveAs('C:\report.xlsx');
  finally
    Excel.Quit;
  end;
end;

// import type library for early binding
// Component → Import Component → Import Type Library
// generates a unit with typed interfaces (early binding, IntelliSense)

// IUnknown - base COM interface
type
  IMyComObject = interface(IUnknown)
    ['{...}']
    function DoSomething: HResult; stdcall;
  end;

// CoCreateInstance for low-level COM
var
  Obj: IUnknown;
  MyObj: IMyComObject;
begin
  CoCreateInstance(CLASS_MyComObject, nil, CLSCTX_INPROC_SERVER,
    IMyComObject, MyObj);
  MyObj.DoSomething;
end;

type
  ICache = interface
    function Get(const Key: string): string;
    procedure Put(const Key, Value: string);
  end;

  TMemoryCache = class(TInterfacedObject, ICache)
  private
    FDict: TDictionary<string, string>;
  public
    constructor Create;
    destructor Destroy; override;
    function Get(const Key: string): string;
    procedure Put(const Key, Value: string);
  end;

  TDataService = class(TInterfacedObject, ICache)
  private
    FCache: ICache;
  public
    constructor Create(ACache: ICache);
    // 'implements' delegates ICache to FCache
    property Cache: ICache read FCache implements ICache;
  end;

// usage - TDataService exposes ICache via delegation
var
  Service: ICache;
begin
  Service := TDataService.Create(TMemoryCache.Create);
  Service.Put('key1', 'value1');    // delegates to TMemoryCache
  ShowMessage(Service.Get('key1'));
end;

// QueryInterface / Supports
var
  Obj: TInterfacedObject;
  Intf: ICache;
begin
  Obj := TMemoryCache.Create;
  if Supports(Obj, ICache, Intf) then
    Intf.Put('a', 'b');
end;

type
  TParent = class;
  TChild = class;

  TParent = class(TInterfacedObject)
  private
    FChild: TChild;
    procedure ChildCallback(const Msg: string);
  public
    destructor Destroy; override;
    property Child: TChild read FChild;
  end;

  TChild = class(TInterfacedObject)
  private
    // [Weak] avoids circular reference counting (parent-child cycle)
    [Weak] FParent: TParent;
    FCallback: TProc<string>;
  public
    constructor Create(AParent: TParent);
    property Parent: TParent read FParent;
  end;

  // [Unsafe] - raw pointer, no ref counting at all
  // [Weak] - tracked but doesn't increment ref count
  // (default) - strong reference, increments ref count

destructor TParent.Destroy;
begin
  FChild := nil;  // releases strong ref
  inherited;
end;

// without [Weak], this creates a memory leak:
// Parent holds Child (ref=1), Child holds Parent (ref=1)
// neither ref count ever reaches 0 → leak

var
  Parent: TParent;
begin
  Parent := TParent.Create;
  // when Parent goes out of scope, both are freed correctly
end;

type
  TWorkerThread = class(TThread)
  private
    FResult: Integer;
  protected
    procedure Execute; override;
  public
    property Result: Integer read FResult;
  end;

procedure TWorkerThread.Execute;
var
  I: Integer;
begin
  FResult := 0;
  for I := 1 to 100 do
  begin
    if Terminated then Break;       // check for cancellation
    FResult := FResult + I;
    Sleep(10);                      // simulate work
  end;

  // update UI from background thread
  TThread.Synchronize(nil,
    procedure
    begin
      Form1.Label1.Caption := 'Done: ' + IntToStr(FResult);
    end);
end;

// create and run
var
  Worker: TWorkerThread;
begin
  Worker := TWorkerThread.Create(True);  // suspended
  Worker.FreeOnTerminate := True;        // auto-free when done
  Worker.Start;                          // begin execution
end;

// TThread.CreateAnonymousThread - quick one-off
TThread.CreateAnonymousThread(
  procedure
  var I: Integer;
  begin
    for I := 1 to 10 do
      TThread.Queue(nil,
        procedure
        begin
          Form1.Label1.Caption := IntToStr(I);
        end);
  end).Start;

uses System.Threading, System.SyncObjs;

// TTask - async operations
var
  Task: ITask;
begin
  Task := TTask.Create(
    procedure
    begin
      Sleep(2000);  // simulate work
      TThread.Queue(nil,
        procedure
        begin
          ShowMessage('Task done');
        end);
    end);
  Task.Start;
end;

// TTask.WaitForAll - wait for multiple tasks
var
  Tasks: array of ITask;
begin
  SetLength(Tasks, 3);
  Tasks[0] := TTask.Create(procedure begin DownloadFile('a.txt'); end);
  Tasks[1] := TTask.Create(procedure begin DownloadFile('b.txt'); end);
  Tasks[2] := TTask.Create(procedure begin DownloadFile('c.txt'); end);

  for var T in Tasks do T.Start;

  // wait for all (with timeout)
  if TTask.WaitForAll(Tasks, 30000) then
    ShowMessage('All downloads complete')
  else
    ShowMessage('Timeout');
end;

// TTask.Future<T> - async with return value
var
  Future: IFuture<string>;
begin
  Future := TTask.Future<string>(
    function: string
    begin
      Result := FetchDataFromServer;  // long operation
    end);

  // do other work...
  ShowMessage('Result: ' + Future.Value);  // blocks until ready
end;

uses System.Threading, System.SyncObjs;

// TParallel.For - parallelized loop
var
  Sum: Integer;
  Lock: TCriticalSection;
  I: Integer;
begin
  Sum := 0;
  Lock := TCriticalSection.Create;
  try
    TParallel.&For(1, 1000000,
      procedure(Index: Integer)
      begin
        // thread-safe accumulation
        Lock.Enter;
        try
          Sum := Sum + Index;
        finally
          Lock.Leave;
        end;
      end);
    ShowMessage('Sum: ' + IntToStr(Sum));
  finally
    Lock.Free;
  end;
end;

// with stride and state
TParallel.&For(1, 100,
  procedure(Index: Integer; var State: TParallelLoopState)
  begin
    if Index = 50 then
      State.Break;                  // stop after current iterations
    // process Index...
  end);

// TParallel.For with step (stride)
TParallel.&For(0, 99, 2,    // 0, 2, 4, 6, ...
  procedure(Index: Integer)
  begin
    ProcessEven(Index);
  end);

// nested parallel loops (use sparingly)
TParallel.&For(0, 9,
  procedure(I: Integer)
  begin
    TParallel.&For(0, 9,
      procedure(J: Integer)
      begin
        Matrix[I, J] := Compute(I, J);
      end);
  end);

uses System.SyncObjs;

// TCriticalSection - mutual exclusion
var
  CS: TCriticalSection;
begin
  CS := TCriticalSection.Create;
  try
    CS.Enter;
    try
      // exclusive access to shared data
    finally
      CS.Leave;
    end;
  finally
    CS.Free;
  end;
end;

// TEvent - signaling between threads
var
  Event: TEvent;
begin
  Event := TEvent.Create(nil, True, False, '');  // manual reset
  try
    // thread 1: wait
    if Event.WaitFor(5000) = wrSignaled then
      ShowMessage('Signaled');

    // thread 2: signal
    Event.SetEvent;    // wake waiting threads
    Event.ResetEvent;  // clear signal
  finally
    Event.Free;
  end;
end;

// TMonitor - lock any object
var
  List: TList<Integer>;
begin
  TMonitor.Enter(List);
  try
    List.Add(42);
  finally
    TMonitor.Exit(List);
  end;

  // TMonitor.Wait / Pulse (like Java wait/notify)
  TMonitor.Enter(List);
  try
    while List.Count = 0 do
      TMonitor.Wait(List, 1000);  // release lock, wait
    TMonitor.PulseAll(List);      // wake waiting threads
  finally
    TMonitor.Exit(List);
  end;
end;

// TInterlocked - atomic operations
TInterlocked.Increment(Counter);
TInterlocked.Exchange(Value, 42);

uses System.Threading, System.SyncObjs;

// configure thread pool
var
  Pool: TThreadPool;
begin
  Pool := TThreadPool.Create;
  try
    Pool.SetMaxWorkerThreads(8);
    Pool.SetMinWorkerThreads(2);

    // use pool with TTask
    TTask.Run(
      procedure
      begin
        // runs on the pool
      end, Pool);
  finally
    Pool.Free;
  end;
end;

// async/await pattern using futures
function FetchDataAsync: IFuture<TStrings>;
begin
  Result := TTask.Future<TStrings>(
    function: TStrings
    begin
      Result := TStringList.Create;
      // simulate slow fetch
      TThread.Sleep(2000);
      Result.LoadFromFile('data.txt');
    end);
end;

// chain tasks
var
  Task1, Task2: ITask;
begin
  Task1 := TTask.Run(
    procedure
    begin
      DownloadFile('part1.zip');
    end);

  // Task2 runs after Task1 completes
  Task2 := Task1.ContinueWith(
    procedure(const ATask: ITask)
    begin
      if ATask.Status = TTaskStatus.Completed then
        ProcessFile('part1.zip')
      else
        ShowMessage('Download failed');
    end);
end;

// cancellation
var
  Cancel: ICancellation;
begin
  Cancel := TTask.CurrentTask.Cancellation;
  while not Cancel.IsCancelled do
  begin
    DoChunk;
    Sleep(100);
  end;
end;

uses IdTCPClient, IdTCPServer, IdContext;

// TCP Client
var
  Client: TIdTCPClient;
  Response: string;
begin
  Client := TIdTCPClient.Create(nil);
  try
    Client.Host := 'example.com';
    Client.Port := 8080;
    Client.ConnectTimeout := 5000;
    Client.Connect;
    try
      Client.IOHandler.WriteLn('Hello Server');
      Response := Client.IOHandler.ReadLn;
      ShowMessage('Server: ' + Response);
    finally
      Client.Disconnect;
    end;
  finally
    Client.Free;
  end;
end;

// TCP Server
type
  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;
    procedure FormCreate(Sender: TObject);
    procedure ServerExecute(AContext: TIdContext);
  end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  IdTCPServer1.DefaultPort := 8080;
  IdTCPServer1.OnExecute := ServerExecute;
  IdTCPServer1.Active := True;
end;

procedure TForm1.ServerExecute(AContext: TIdContext);
var
  Msg: string;
begin
  Msg := AContext.Connection.IOHandler.ReadLn;
  AContext.Connection.IOHandler.WriteLn('Echo: ' + Msg);
  if Msg = 'quit' then
    AContext.Connection.Disconnect;
end;

uses IdHTTP, IdSSLOpenSSL, System.JSON;

var
  Http: TIdHTTP;
  SSL: TIdSSLIOHandlerSocketOpenSSL;
  Response: string;
  JSON: TJSONObject;
  Params: TStringList;
begin
  Http := TIdHTTP.Create(nil);
  SSL := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  try
    Http.IOHandler := SSL;
    SSL.SSLOptions.Method := sslvTLSv1_2;
    Http.Request.ContentType := 'application/json';
    Http.Request.CustomHeaders.AddValue('Authorization', 'Bearer token123');

    // GET request
    Response := Http.Get('https://api.example.com/users');
    ShowMessage(Response);

    // POST with JSON body
    JSON := TJSONObject.Create;
    try
      JSON.AddPair('name', 'Alice');
      JSON.AddPair('age', 30);
      Response := Http.Post('https://api.example.com/users', JSON.ToJSON);
    finally
      JSON.Free;
    end;

    // POST form data
    Params := TStringList.Create;
    try
      Params.Add('username=alice');
      Params.Add('password=secret');
      Response := Http.Post('https://api.example.com/login', Params);
    finally
      Params.Free;
    end;

    // handle errors
    try
      Http.Get('https://api.example.com/missing');
    except
      on E: EIdHTTPProtocolException do
        ShowMessage('HTTP ' + IntToStr(E.ErrorCode) + ': ' + E.ErrorMessage);
    end;
  finally
    SSL.Free;
    Http.Free;
  end;
end;

uses IdSMTP, IdMessage, IdSSLOpenSSL, IdExplicitTLSClientServerBase;

var
  SMTP: TIdSMTP;
  Msg: TIdMessage;
  SSL: TIdSSLIOHandlerSocketOpenSSL;
begin
  SMTP := TIdSMTP.Create(nil);
  Msg := TIdMessage.Create(nil);
  SSL := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  try
    // SMTP config (Gmail example)
    SMTP.Host := 'smtp.gmail.com';
    SMTP.Port := 587;
    SMTP.UseTLS := utUseExplicitTLS;
    SMTP.IOHandler := SSL;
    SSL.SSLOptions.Method := sslvTLSv1_2;
    SMTP.Username := '[email protected]';
    SMTP.Password := 'app-password';

    // message
    Msg.From.Address := '[email protected]';
    Msg.From.Name := 'My App';
    Msg.Recipients.Add.Address := '[email protected]';
    Msg.Subject := 'Test from Delphi';
    Msg.Body.Text := 'Hello,' + sLineBreak + 'This is a test email.';

    // attachment
    var Attachment := TIdAttachmentFile.Create(Msg.MessageParts,
      'C:\report.pdf');

    // HTML body
    Msg.ContentType := 'text/html';
    Msg.Body.Text := '<h1>Hello</h1><p>HTML email from Delphi</p>';

    // connect and send
    SMTP.Connect;
    try
      SMTP.Send(Msg);
      ShowMessage('Email sent!');
    finally
      SMTP.Disconnect;
    end;
  finally
    SSL.Free;
    Msg.Free;
    SMTP.Free;
  end;
end;

uses IdUDPClient, IdUDPServer, IdSocketHandle;

// UDP Client (connectionless, fire-and-forget)
var
  UDP: TIdUDPClient;
begin
  UDP := TIdUDPClient.Create(nil);
  try
    UDP.Host := '255.255.255.255';  // broadcast
    UDP.Port := 9999;
    UDP.BroadcastEnabled := True;
    UDP.Send('DISCOVER');

    // receive response
    var Response: string;
    UDP.ReceiveString(Response, 1000);  // timeout 1s
    ShowMessage(Response);
  finally
    UDP.Free;
  end;
end;

// UDP Server
type
  TForm1 = class(TForm)
    IdUDPServer1: TIdUDPServer;
    procedure FormCreate(Sender: TObject);
    procedure UDPRead(AThread: TIdUDPListenerThread;
      const AData: TIdBytes; ABinding: TIdSocketHandle);
  end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  IdUDPServer1.DefaultPort := 9999;
  IdUDPServer1.OnUDPRead := UDPRead;
  IdUDPServer1.Active := True;
end;

procedure TForm1.UDPRead(AThread: TIdUDPListenerThread;
  const AData: TIdBytes; ABinding: TIdSocketHandle);
var
  Msg: string;
begin
  Msg := BytesToString(AData);
  // reply to sender
  ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort,
    ToBytes('ACK: ' + Msg));
end;

// raw socket with TIdIOHandlerSocket
// for low-level protocols, use WinSock2 unit directly

uses IdFTP, IdFTPCommon, IdExplicitTLSClientServerBase;

// FTP client
var
  FTP: TIdFTP;
begin
  FTP := TIdFTP.Create(nil);
  try
    FTP.Host := 'ftp.example.com';
    FTP.Username := 'user';
    FTP.Password := 'pass';
    FTP.Passive := True;            // NAT-friendly mode
    FTP.UseTLS := utUseExplicitTLS;
    FTP.Connect;
    try
      // list directory
      var Listing: TStringList := TStringList.Create;
      try
        FTP.List(Listing);
        for var S in Listing do
          ShowMessage(S);
      finally
        Listing.Free;
      end;

      // change directory
      FTP.ChangeDir('/uploads');

      // upload/download
      FTP.Put('C:\local.txt', 'remote.txt');
      FTP.Get('remote.txt', 'C:\downloaded.txt');

      // create/remove directory
      FTP.MakeDir('newfolder');
      FTP.RemoveDir('oldfolder');
    finally
      FTP.Disconnect;
    end;
  finally
    FTP.Free;
  end;
end;

// REST Client (built-in, no Indy needed)
uses REST.Client, REST.Types;

var
  RESTClient: TRESTClient;
  RESTRequest: TRESTRequest;
  RESTResponse: TRESTResponse;
begin
  RESTClient := TRESTClient.Create('https://api.example.com');
  RESTRequest := TRESTRequest.Create(RESTClient);
  RESTResponse := TRESTResponse.Create(nil);
  try
    RESTRequest.Resource := 'users/{id}';
    RESTRequest.Method := TRESTRequestMethod.rmGET;
    RESTRequest.Params.AddUrlSegment('id', '42');
    RESTRequest.Params.AddItem('fields', 'name,email', pkGETorPOST);

    RESTRequest.Execute;
    ShowMessage(RESTResponse.Content);     // JSON response

    // access JSON fields directly
    ShowMessage(RESTResponse.JSONValue.GetValue<string>('name'));
  finally
    RESTResponse.Free;
    RESTRequest.Free;
    RESTClient.Free;
  end;
end;

// --- MyLib.dpr (DLL project) ---
library MyLib;

uses
  System.SysUtils, System.Classes;

// exported function (stdcall for compatibility)
function Add(A, B: Integer): Integer; stdcall;
begin
  Result := A + B;
end;

// exported procedure
procedure ShowMessage(const Msg: PChar); stdcall;
begin
  WriteLn(Msg);
end;

// export table
exports
  Add name 'Add',
  ShowMessage name 'ShowMessage';

begin
end.

// --- MainApp.dpr (consumer) ---
// static import
function Add(A, B: Integer): Integer; stdcall; external 'MyLib.dll';
procedure ShowMsg(const Msg: PChar); stdcall; external 'MyLib.dll';

begin
  ShowMessage(IntToStr(Add(3, 4)));  // 7
end;

// dynamic loading (load at runtime)
var
  LibHandle: THandle;
  AddFunc: function(A, B: Integer): Integer; stdcall;
begin
  LibHandle := LoadLibrary('MyLib.dll');
  if LibHandle <> 0 then
  try
    @AddFunc := GetProcAddress(LibHandle, 'Add');
    if Assigned(@AddFunc) then
      ShowMessage(IntToStr(AddFunc(10, 20)));
  finally
    FreeLibrary(LibHandle);
  end;
end;

// --- PluginDLL.dpr ---
library PluginDLL;

type
  IPlugin = interface
    ['{12345678-1234-1234-1234-123456789012}']
    function GetName: PChar; stdcall;
    function Execute(const Input: PChar): PChar; stdcall;
    procedure Free; stdcall;
  end;

  TMyPlugin = class(TInterfacedObject, IPlugin)
  public
    function GetName: PChar; stdcall;
    function Execute(const Input: PChar): PChar; stdcall;
    procedure Free; stdcall;
  end;

function TMyPlugin.GetName: PChar;
begin
  Result := 'My Plugin v1.0';
end;

function TMyPlugin.Execute(const Input: PChar): PChar;
begin
  Result := PChar('Processed: ' + Input);
end;

// factory function - creates and returns the plugin
function CreatePlugin: IPlugin; stdcall;
begin
  Result := TMyPlugin.Create;
end;

exports CreatePlugin;

// --- HostApp.dpr ---
type
  IPlugin = interface
    ['{12345678-1234-1234-1234-123456789012}']
    function GetName: PChar; stdcall;
    function Execute(const Input: PChar): PChar; stdcall;
    procedure Free; stdcall;
  end;

var
  CreatePlugin: function: IPlugin; stdcall;
  Plugin: IPlugin;
  Handle: THandle;
begin
  Handle := LoadLibrary('PluginDLL.dll');
  if Handle <> 0 then
  try
    @CreatePlugin := GetProcAddress(Handle, 'CreatePlugin');
    if Assigned(@CreatePlugin) then
    begin
      Plugin := CreatePlugin;
      ShowMessage(Plugin.GetName);
      ShowMessage(Plugin.Execute('test'));
    end;
  finally
    FreeLibrary(Handle);
  end;
end;

// --- MyPackage.dpk (runtime package) ---
package MyPackage;

requires
  rtl,
  vcl;

contains
  MyUnit in 'MyUnit.pas',
  MyForm in 'MyForm.pas' {Form1};

// compile: dcc32 -B MyPackage.dpk
// produces MyPackage.bpl (shared runtime package)

// --- Using the package ---
// Option 1: link statically (compile-time reference)
// Project → Options → Packages → Runtime packages → add MyPackage.bpl

// Option 2: load dynamically with LoadPackage
var
  PackageModule: THandle;
  FormClass: TPersistentClass;
begin
  PackageModule := LoadPackage('MyPackage.bpl');
  try
    // register and use forms/classes from the package
    FormClass := GetClass('TForm1');
    if FormClass <> nil then
      with TFormClass(FormClass).Create(Application) do
        try
          ShowModal;
        finally
          Free;
        end;
  finally
    UnloadPackage(PackageModule);
  end;
end;

// RegisterClass in the package's unit:
unit MyForm;
interface
uses Vcl.Forms;
type
  TForm1 = class(TForm)
  end;
implementation
initialization
  RegisterClass(TForm1);    // make class discoverable
finalization
  UnRegisterClass(TForm1);
end.

// PROBLEM: different memory managers in EXE and DLL
// → crashes when freeing memory allocated in another module

// Solution 1: ShareMem (Delphi-to-Delphi only)
// First unit in both EXE and DLL .dpr file:
uses
  ShareMem;  // uses BorlndMM.dll as shared memory manager

// Solution 2: Caller allocates, caller frees (safest)
// DLL fills a buffer provided by the caller
procedure GetData(Buffer: PChar; var BufSize: Integer); stdcall;
var
  Data: string;
begin
  Data := 'Hello from DLL';
  BufSize := Length(Data) + 1;
  if Buffer <> nil then
    StrLCopy(Buffer, PChar(Data), BufSize);
end;

// caller:
var
  Size: Integer;
  Buffer: PChar;
begin
  GetData(nil, Size);              // query size
  GetMem(Buffer, Size);            // allocate
  try
    GetData(Buffer, Size);         // fill
    ShowMessage(Buffer);
  finally
    FreeMem(Buffer);               // caller frees
  end;
end;

// Solution 3: Use SafeCall / COM-style allocation
// Solution 4: Use FastMM as shared manager (modern approach)
// Add SimpleShareMem unit (uses FastMM) to both projects

// Solution 5: Return only simple types / PChar with callback
type
  TFreeCallback = procedure(Ptr: Pointer); stdcall;
function CreateString(out S: PChar; FreeProc: TFreeCallback): Boolean; stdcall;
begin
  S := StrNew('Allocated in DLL');
  Result := True;
  // caller calls FreeProc(S) which calls StrDispose in the DLL
end;

// --- Resource script (.rc file) ---
// MyResources.rc:
//   LOGO     RCDATA "logo.png"
//   ICON1    ICON    "app.ico"
//   VERSION  VERSIONINFO ...
//   WAVE1    WAVE    "sound.wav"
//   STR1     STRINGTABLE { "Hello" }

// compile: brcc32 MyResources.rc → MyResources.res
// or add .rc to project (auto-compiled)

// --- In .dpr ---
{$R MyResources.res}  // link resource

// --- Loading resources ---
uses System.Classes, Vcl.Graphics, Winapi.Windows;

// load RCDATA (binary data)
var
  Stream: TResourceStream;
begin
  Stream := TResourceStream.Create(HInstance, 'LOGO', RT_RCDATA);
  try
    Image1.Picture.LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

// load icon
var
  Icon: TIcon;
begin
  Icon := TIcon.Create;
  try
    Icon.Handle := LoadIcon(HInstance, 'ICON1');
    Image1.Picture.Icon.Assign(Icon);
  finally
    Icon.Free;
  end;
end;

// load string resource
var
  S: string;
  Buffer: array[0..255] of Char;
begin
  LoadString(HInstance, 1, Buffer, SizeOf(Buffer));
  S := Buffer;
end;

// embed a file as resource at compile time
// {$R 'data.bin' 'data.bin'}  // or use .rc

// Conditional breakpoints (set in IDE):
//   Break when expression is true
//   e.g., (i > 100) and (List.Count > 0)

// Log breakpoints (no break, just log):
//   Log message: "Iteration {i}, Count={List.Count}"

// Trace points / Action breakpoints:
//   Run macro or evaluate expression on hit

// Code-based breakpoints:
var
  I: Integer;
begin
  for I := 1 to 1000 do
  begin
    // break only when condition met
    if (I mod 100 = 0) and DebugHook <> 0 then
      asm int 3 end;            // hard breakpoint (CPU trap)

    // or use OutputDebugString for logging
    OutputDebugString(PChar('Processing ' + IntToStr(I)));
  end;
end;

// Assert (only in debug builds)
Assert(List.Count > 0, 'List must not be empty');

// DebugHook: 0 = release, 1 = IDE, 2 = IDE step-over
if DebugHook <> 0 then
  ShowMessage('Running in debugger');

// Watch and Evaluate expressions in IDE:
//   List.Count
//   List[0].Name
//   TMyObject(Obj).PrivateField  (with "Use Debug DCUs")

// Call Stack window shows the call chain
// Threads window shows all active threads
// Local Variables shows current scope variables

uses
  System.SysUtils, System.Diagnostics;

// structured exception handling
try
  RiskyOperation;
except
  on E: EDivByZero do
    ShowMessage('Division error: ' + E.Message);
  on E: EAccessViolation do
    ShowMessage('Access violation at ' + E.Message);
  on E: Exception do
  begin
    ShowMessage('Unexpected: ' + E.ClassName + ': ' + E.Message);
    raise;                         // re-raise
  end;
end;

// finally (always executes)
try
  AcquireResource;
  UseResource;
finally
  ReleaseResource;                 // always runs
end;

// nested try/except/finally
try
  try
    RiskyCode;
  except
    on E: Exception do
    begin
      LogError(E);
      raise EAbort.Create('');     // suppress display
    end;
  end;
finally
  Cleanup;
end;

// global exception handler
procedure TForm1.ApplicationEvents1Exception(Sender: TObject; E: Exception);
begin
  LogError(Format('%s: %s', [E.ClassName, E.Message]));
  if not (E is EAbort) then
    ShowMessage('Error: ' + E.Message);
end;

// get stack trace (with JCL or MadExcept)
// JclDebug: JclCreateStackInfo, JclLastExceptStackList

uses System.Diagnostics;

// TStopwatch - precise timing
var
  SW: TStopwatch;
  Elapsed: Int64;
begin
  SW := TStopwatch.StartNew;
  try
    ExpensiveOperation;
  finally
    SW.Stop;
    ShowMessage(Format('Elapsed: %d ms', [SW.ElapsedMilliseconds]));
  end;
end;

// benchmark comparison
function Benchmark(const Name: string; const Action: TProc): Int64;
var
  SW: TStopwatch;
  I: Integer;
begin
  SW := TStopwatch.StartNew;
  for I := 1 to 1000 do
    Action;
  SW.Stop;
  WriteLn(Format('%s: %d ms', [Name, SW.ElapsedMilliseconds]));
  Result := SW.ElapsedMilliseconds;
end;

// memory usage
var
  Mem: TMemoryManagerState;
begin
  GetMemoryManagerState(Mem);
  ShowMessage(Format('Allocated: %d bytes', [Mem.TotalAllocated]));

  // report memory leaks on shutdown
  ReportMemoryLeaksOnShutdown := True;  // shows leak dialog on exit
end;

// common optimizations:
// 1. Use TStringBuilder for heavy string concatenation
var SB := TStringBuilder.Create;
try
  for var I := 1 to 10000 do
    SB.Append('Line ').Append(I).AppendLine;
  Result := SB.ToString;
finally
  SB.Free;
end;

// 2. SetLength once, not in a loop
SetLength(Result, Count);  // pre-allocate
for I := 0 to Count - 1 do
  Result[I] := Compute(I);

// 3. Use const for strings/arrays (avoids copy)
procedure Process(const Data: string);  // const = no copy

// Rule: every Create needs a Free (or use interfaces)

// Pattern 1: try/finally
var
  Obj: TMyObject;
begin
  Obj := TMyObject.Create;
  try
    Obj.DoWork;
  finally
    Obj.Free;    // always freed
  end;
end;

// Pattern 2: interface reference counting (automatic)
var
  Obj: IMyInterface;
begin
  Obj := TMyObject.Create;  // TInterfacedObject
  Obj.DoWork;
  // freed automatically when Obj goes out of scope
end;

// Pattern 3: TObjectList (owns children)
var
  List: TObjectList<TPerson>;
begin
  List := TObjectList<TPerson>.Create(True);  // OwnsObjects
  try
    List.Add(TPerson.Create('Alice'));
    List.Add(TPerson.Create('Bob'));
    // freeing List frees all TPerson objects
  finally
    List.Free;
  end;
end;

// Detecting leaks
// 1. ReportMemoryLeaksOnShutdown := True;
// 2. FastMM (default since D2006) with FullDebugMode
//    → logs leaks with stack traces to file
// 3. Set breakpoint on System._DebugIntfMemLeak (FastMM)

// Common leak causes:
// - Create without Free (missing try/finally)
// - Event handler assigned but never removed
// - Circular references (use [Weak])
// - TThread not freed (FreeOnTerminate := True)
// - Global objects not freed in finalization

// finalization section for globals
var
  GlobalCache: TDictionary<string, TObject>;
initialization
  GlobalCache := TDictionary<string, TObject>.Create;
finalization
  GlobalCache.Free;    // cleanup on shutdown

// DUnitX - unit testing framework
uses DUnitX.TestFramework;

type
  [TestFixture]
  TCalculatorTests = class
  public
    [Setup]
    procedure Setup;

    [TearDown]
    procedure TearDown;

    [Test]
    procedure TestAdd;

    [Test]
    [TestCase('A', '1,2,3')]
    [TestCase('B', '10,20,30')]
    procedure TestAddParam(A, B, Expected: Integer);

    [Test]
    procedure TestDivideByZero;
  end;

procedure TCalculatorTests.TestAdd;
var
  Calc: TCalculator;
begin
  Calc := TCalculator.Create;
  try
    Assert.AreEqual(5, Calc.Add(2, 3));
    Assert.AreNotEqual(6, Calc.Add(2, 3));
    Assert.IsTrue(Calc.Add(0, 0) = 0);
  finally
    Calc.Free;
  end;
end;

procedure TCalculatorTests.TestDivideByZero;
var
  Calc: TCalculator;
begin
  Calc := TCalculator.Create;
  try
    Assert.WillRaise(
      procedure
      begin
        Calc.Divide(10, 0);
      end, EDivByZero);
  finally
    Calc.Free;
  end;
end;

// mock with interfaces
type
  [Mock]
  ILogger = interface
    ['{...}']
    procedure Log(const Msg: string);
  end;

// Delphi Mocks framework
var
  MockLogger: TMock<ILogger>;
begin
  MockLogger := TMock<ILogger>.Create;
  MockLogger.Setup.Expect.Once.When.Log('test');
  // ... use MockLogger.Object ...
  MockLogger.VerifyAll;  // asserts Log was called
end;

type
  TStack<T> = class
  private
    FItems: TArray<T>;
    FCount: Integer;
  public
    procedure Push(const AValue: T);
    function Pop: T;
    function Peek: T;
    function Count: Integer;
  end;

procedure TStack<T>.Push(const AValue: T);
begin
  if FCount = Length(FItems) then
    SetLength(FItems, FCount * 2 + 4);
  FItems[FCount] := AValue;
  Inc(FCount);
end;

uses
  System.Generics.Collections;

var
  Dict: TDictionary<string, Integer>;
begin
  Dict := TDictionary<string, Integer>.Create;
  try
    Dict.Add('apple', 5);
    Dict.Add('banana', 3);
    Dict.OrAdd('apple', 10);  // add or replace

    if Dict.TryGetValue('apple', Value) then
      Writeln(Value);

    for var Pair in Dict do
      Writeln(Pair.Key, ': ', Pair.Value);
  finally
    Dict.Free;
  end;
end;

var
  List: TList<Integer>;
begin
  List := TList<Integer>.Create;
  try
    List.AddRange([5, 2, 8, 1, 9]);
    List.Sort;  // ascending

    // custom comparer (descending)
    List.Sort(TComparer<Integer>.Construct(
      function(const L, R: Integer): Integer
      begin
        Result := R - L;
      end));

    List.BinarySearch(8, Index);  // requires sorted list
  finally
    List.Free;
  end;
end;

type
  TRepository<T: class, constructor> = class
  public
    function CreateInstance: T;
    procedure Save(const AEntity: T);
  end;

function TRepository<T>.CreateInstance: T;
begin
  Result := T.Create;  // requires 'constructor' constraint
end;

// multiple constraints: class, constructor, specific base
type
  TControlFactory<T: TControl, constructor> = class ... end;

var
  Dict: TObjectDictionary<string, TButton>;
begin
  // owns values — frees them automatically
  Dict := TObjectDictionary<string, TButton>.Create([doOwnsValues]);
  try
    Dict.Add('btn1', TButton.Create(nil));
    Dict.Add('btn2', TButton.Create(nil));
    Dict.Remove('btn1');  // frees the TButton
  finally
    Dict.Free;  // frees remaining buttons
  end;
end;

var
  Adder: TFunc<Integer, Integer, Integer>;
begin
  Adder := function(A, B: Integer): Integer
    begin
      Result := A + B;
    end;

  Writeln(Adder(3, 4));  // 7
end;

function MakeMultiplier(Factor: Integer): TFunc<Integer, Integer>;
begin
  Result := function(X: Integer): Integer
    begin
      Result := X * Factor;  // captures Factor
    end;
end;

var
  Double: TFunc<Integer, Integer>;
  Triple: TFunc<Integer, Integer>;
begin
  Double := MakeMultiplier(2);
  Triple := MakeMultiplier(3);
  Writeln(Double(10));  // 20
  Writeln(Triple(10));  // 30
end;

type
  TIntFunc = reference to function(X: Integer): Integer;

function Apply(const F: TIntFunc; Values: array of Integer): TArray<Integer>;
var
  I: Integer;
begin
  SetLength(Result, Length(Values));
  for I := 0 to High(Values) do
    Result[I] := F(Values[I]);
end;

var
  Squared: TArray<Integer>;
begin
  Squared := Apply(function(X: Integer): Integer
    begin
      Result := X * X;
    end, [1, 2, 3, 4, 5]);
end;

procedure SetupButton(Button: TButton; const Caption: string);
begin
  Button.Caption := Caption;
  Button.OnClick := procedure(Sender: TObject)
    begin
      ShowMessage(Caption + ' clicked!');  // captures Caption
    end;
end;

// instead of:
//   procedure TForm1.Button1Click(Sender: TObject);
//   begin
//     ShowMessage('Button1 clicked!');
//   end;

TThread.CreateAnonymousThread(
  procedure
  var
    I: Integer;
  begin
    for I := 1 to 10 do
    begin
      TThread.Queue(nil,
        procedure
        begin
          Memo1.Lines.Add('Progress: ' + I.ToString);
        end);
      Sleep(100);
    end;
  end).Start;

type
  DisplayNameAttribute = class(TCustomAttribute)
  private
    FName: string;
  public
    constructor Create(const AName: string);
    property Name: string read FName;
  end;

  constructor DisplayNameAttribute.Create(const AName: string);
  begin
    FName := AName;
  end;

  [DisplayName('User Account')]
  TUser = class
    [DisplayName('Full Name')]
    FName: string;
  end;

uses
  System.Rtti;

var
  Ctx: TRttiContext;
  RttiType: TRttiType;
  Attr: TCustomAttribute;
begin
  Ctx := TRttiContext.Create;
  try
    RttiType := Ctx.GetType(TUser);
    for Attr in RttiType.GetAttributes do
      if Attr is DisplayNameAttribute then
        Writeln(DisplayNameAttribute(Attr).Name);
  finally
    Ctx.Free;
  end;
end;

var
  Ctx: TRttiContext;
  FieldType: TRttiField;
  Method: TRttiMethod;
  User: TUser;
begin
  Ctx := TRttiContext.Create;
  try
    User := TUser.Create;
    try
      for FieldType in Ctx.GetType(TUser).GetFields do
      begin
        Writeln(FieldType.Name, ': ', FieldType.FieldType.Name);
        FieldType.SetValue(User, 'Alice');  // set by RTTI
      end;
      Writeln(FieldType.GetValue(User).AsString);
    finally
      User.Free;
    end;
  finally
    Ctx.Free;
  end;
end;

var
  Ctx: TRttiContext;
  Prop: TRttiProperty;
  Instance: TMyClass;
begin
  Instance := TMyClass.Create;
  try
    for Prop in Ctx.GetType(TMyClass).GetProperties do
    begin
      if Prop.IsReadable then
        Writeln(Prop.Name, ' = ', Prop.GetValue(Instance).ToString);
      if Prop.IsWritable and (Prop.PropertyType.TypeKind = tkInteger) then
        Prop.SetValue(Instance, 42);
    end;
  finally
    Instance.Free;
  end;
end;

var
  Ctx: TRttiContext;
  Method: TRttiMethod;
  Args: array of TValue;
  Result: TValue;
begin
  Method := Ctx.GetType(TMyClass).GetMethod('CalculateTotal');
  if Assigned(Method) then
  begin
    SetLength(Args, 2);
    Args[0] := 10;
    Args[1] := 20;
    Result := Method.Invoke(MyInstance, Args);
    Writeln(Result.AsInteger);
  end;
end;

type
  IShape = interface
    ['{A1B2C3D4-E5F6-7890-ABCD-EF1234567890}']
    function GetArea: Double;
    function GetPerimeter: Double;
    procedure Draw;
    property Color: TColor read FColor write SetColor;
  end;

  TCircle = class(TInterfacedObject, IShape)
  private
    FRadius: Double;
    FColor: TColor;
    procedure SetColor(Value: TColor);
  public
    constructor Create(ARadius: Double);
    function GetArea: Double;
    function GetPerimeter: Double;
    procedure Draw;
  end;

var
  Shape: IShape;
begin
  Shape := TCircle.Create(5.0);  // refcount = 1
  // ... use Shape ...
end;  // refcount drops to 0, object freed automatically

// Mixing interface and object references — DANGER:
var
  Obj: TCircle;
begin
  Obj := TCircle.Create(5.0);
  Shape := Obj;       // refcount = 1
  Shape := nil;       // refcount = 0, Obj freed!
  Obj.GetArea;        // AV — dangling pointer
end;

type
  IReadable = interface
    function Read: string;
  end;

  IWritable = interface
    procedure Write(const S: string);
  end;

  IStream = interface(IReadable, IWritable)
    procedure Flush;
  end;

  TFileStream = class(TInterfacedObject, IStream, IReadable, IWritable)
    // must implement all methods from all interfaces
  end;

uses
  System.SysUtils, System.TypInfo;

var
  Obj: TObject;
  Shape: IShape;
begin
  Obj := TCircle.Create(5.0);
  try
    if Supports(Obj, IShape, Shape) then
      Writeln(Shape.GetArea:0:2);

    // 'as' cast — raises if not supported
    Shape := Obj as IShape;

    // type info
    if Supports(Obj, IShape) then
      Writeln('Obj supports IShape');
  finally
    Obj.Free;  // object reference — must free manually
  end;
end;

type
  ILogger = interface
    procedure Log(const Msg: string);
  end;

  TOrderService = class
  private
    FLogger: ILogger;
  public
    constructor Create(ALogger: ILogger);
    procedure ProcessOrder(OrderId: Integer);
  end;

constructor TOrderService.Create(ALogger: ILogger);
begin
  FLogger := ALogger;  // injected dependency
end;

procedure TOrderService.ProcessOrder(OrderId: Integer);
begin
  FLogger.Log('Processing order ' + OrderId.ToString);
end;

var
  List: TObjectList;
  Stream: TFileStream;
begin
  List := TObjectList.Create;
  try
    Stream := TFileStream.Create('data.bin', fmOpenRead);
    try
      // ... use Stream ...
    finally
      Stream.Free;
    end;
  finally
    List.Free;
  end;
end;

type
  TTempFile = class(TInterfacedObject)
  private
    FName: string;
  public
    constructor Create(const AName: string);
    destructor Destroy; override;
  end;

destructor TTempFile.Destroy;
begin
  if FileExists(FName) then
    DeleteFile(FName);
  inherited;
end;

// usage:
var
  Temp: TTempFile;
begin
  Temp := TTempFile.Create('tmp.txt');
  // ... use file ...
end;  // Temp freed automatically (refcount)

type
  [Weak]
  FParent: TComponent;  // weak reference — no refcount increment

  // or for interfaces:
  [Weak]
  FLogger: ILogger;

// TComponent uses notification-based weak refs:
type
  TChild = class(TComponent)
  private
    FParent: TComponent;
  public
    property Parent: TComponent read FParent write FParent;
  end;

type
  TPoint = record  // value type — stack allocated
    X, Y: Double;
    function Distance: Double;
  end;

  TPointObj = class  // reference type — heap allocated
    X, Y: Double;
    function Distance: Double;
  end;

var
  P1, P2: TPoint;
  O1, O2: TPointObj;
begin
  P1 := P2;  // copies values
  O1 := O2;  // copies reference (both point to same object)
end;

uses
  System.ReportMemoryLeaksOnShutdown;

begin
  ReportMemoryLeaksOnShutdown := True;
  // ... your code ...
  // on app exit, leak report shown if any unfreed objects
end;

// FastMM4 (built into modern Delphi):
//   - Detects leaks with call stack
//   - Reports type and count of leaked objects
//   - Use FullDebugMode for detailed diagnostics

// Manual check:
var
  StartMem: Integer;
begin
  StartMem := AllocMemSize;
  // ... code under test ...
  if AllocMemSize > StartMem then
    Writeln('Memory leak detected');
end;

unit MainForm;

interface

uses
  System.SysUtils, System.Types, FMX.Forms, FMX.Controls,
  FMX.Controls.Presentation, FMX.Edit, FMX.Buttons;

type
  TFormMain = class(TForm)
    EditName: TEdit;
    ButtonSubmit: TSpeedButton;
    procedure ButtonSubmitClick(Sender: TObject);
  private
    FName: string;
  public
    property Name: string read FName;
  end;

var
  FormMain: TFormMain;

implementation

procedure TFormMain.ButtonSubmitClick(Sender: TObject);
begin
  FName := EditName.Text;
  Close;
end;

end.

// Layout types: TLayout, TFlowLayout, TGridLayout, TScrollBox
var
  Layout: TFlowLayout;
  Btn: TButton;
begin
  Layout := TFlowLayout.Create(Self);
  Layout.Parent := Self;
  Layout.Align := TAlignLayout.Client;
  Layout.FlowDirection := TFlowDirection.LeftToRight;
  Layout.Justify := TJustifyMode.SpaceBetween;

  for var I := 1 to 5 do
  begin
    Btn := TButton.Create(Self);
    Btn.Parent := Layout;
    Btn.Text := 'Button ' + I.ToString;
    Btn.Margins.Rect := RectF(5, 5, 5, 5);
  end;
end;

// Load a custom style
begin
  TStyleManager.LoadFromFile('Dark.fsf');
  TStyleManager.TrySetStyleFromResource('DarkStyle');
end;

// Apply style to a single control:
Button1.StyleLookup := 'cornerbutton';

// Read style in code:
var
  StyleObj: TFmxObject;
begin
  StyleObj := TStyleManager.ActiveStyle(Self).FindStyleResource('buttonstyle');
end;

// LiveBindings designer for visual data binding
// Tools > LiveBindings Designer

uses
  FMX.Effects, FMX.Ani;

var
  Glow: TGlowEffect;
  Ani: TFloatAnimation;
begin
  // Glow effect on a button
  Glow := TGlowEffect.Create(Button1);
  Glow.Parent := Button1;
  Glow.GlowColor := TAlphaColors.Blue;
  Glow.Enabled := True;

  // Animate opacity
  Ani := TFloatAnimation.Create(Button1);
  Ani.Parent := Button1;
  Ani.PropertyName := 'Opacity';
  Ani.StartValue := 0;
  Ani.EndValue := 1;
  Ani.Duration := 0.5;
  Ani.Start;
end;

uses
  FMX.Platform;

var
  ScreenSvc: IFMXScreenService;
  Size: TPoint;
begin
  if TPlatformServices.Current.SupportsPlatformService(
    IFMXScreenService, IInterface(ScreenSvc)) then
  begin
    Size := ScreenSvc.GetScreenSize;
    Writeln(Size.X.ToString, 'x', Size.Y.ToString);
  end;
end;

// Other services:
//   IFMXClipboardService
//   IFMXDialogService (async message boxes)
//   IFMXVirtualKeyboardService
//   IFMXDeviceService

uses
  FireDAC.Comp.Client, FireDAC.Stan.Def;

var
  FDConn: TFDConnection;
begin
  FDConn := TFDConnection.Create(nil);
  try
    FDConn.DriverName := 'SQLite';
    FDConn.Params.Database := 'app.db';
    FDConn.Params.Add('Encrypt=AES-256');
    FDConn.Params.Password := 'secret';
    FDConn.Connected := True;

    // or use a connection definition file:
    // FDConn.ConnectionDefName := 'MySQLite';
  finally
    FDConn.Free;
  end;
end;

var
  Query: TFDQuery;
begin
  Query := TFDQuery.Create(nil);
  try
    Query.Connection := FDConn;

    // parameterized query (prevents SQL injection)
    Query.SQL.Text := 'SELECT * FROM users WHERE age > :min_age';
    Query.ParamByName('min_age').AsInteger := 18;
    Query.Open;

    while not Query.Eof do
    begin
      Writeln(Query.FieldByName('name').AsString);
      Query.Next;
    end;

    // execute non-query (INSERT/UPDATE/DELETE)
    Query.SQL.Text := 'INSERT INTO users (name, age) VALUES (:n, :a)';
    Query.ParamByName('n').AsString := 'Alice';
    Query.ParamByName('a').AsInteger := 30;
    Query.ExecSQL;
  finally
    Query.Free;
  end;
end;

FDConn.StartTransaction;
try
  Query.SQL.Text := 'UPDATE accounts SET balance = balance - 100 WHERE id = 1';
  Query.ExecSQL;
  Query.SQL.Text := 'UPDATE accounts SET balance = balance + 100 WHERE id = 2';
  Query.ExecSQL;

  FDConn.Commit;
except
  FDConn.Rollback;
  raise;
end;

// nested transactions via savepoints:
FDConn.StartTransaction;
try
  // ... work ...
  FDConn.StartTransaction;  // savepoint
  try
    // ... more work ...
    FDConn.Commit;
  except
    FDConn.Rollback;  // rolls back to savepoint
  end;
finally
  FDConn.Commit;
end;

var
  Table: TFDTable;
begin
  Table := TFDTable.Create(nil);
  try
    Table.Connection := FDConn;
    Table.TableName := 'users';
    Table.IndexFieldNames := 'name';  // ORDER BY
    Table.Open;  // SELECT * FROM users

    // edit current row
    Table.Edit;
    Table.FieldByName('age').AsInteger := 31;
    Table.Post;

    // insert new row
    Table.Append;
    Table.FieldByName('name').AsString := 'Bob';
    Table.FieldByName('age').AsInteger := 25;
    Table.Post;

    // delete current row
    Table.Delete;
  finally
    Table.Free;
  end;
end;

Query.CachedUpdates := True;
Query.Open;

// make many changes locally
while not Query.Eof do
begin
  Query.Edit;
  Query.FieldByName('status').AsString := 'processed';
  Query.Post;
  Query.Next;
end;

// apply all changes in one transaction
FDConn.StartTransaction;
try
  Query.ApplyUpdates;
  FDConn.Commit;
except
  FDConn.Rollback;
  Query.CancelUpdates;
  raise;
end;

// inspect change log:
Query.Status;  // TUpdateStatus (usModified, usInserted, usDeleted)

uses
  REST.Client, REST.Types;

var
  Client: TRESTClient;
  Request: TRESTRequest;
  Response: TRESTResponse;
begin
  Client := TRESTClient.Create('https://api.example.com');
  Request := TRESTRequest.Create(Client);
  Response := TRESTResponse.Create(Client);
  try
    Request.Resource := '/users/{id}';
    Request.Method := TRESTRequestMethod.rmGET;
    Request.Params.AddUrlSegment('id', '42');
    Request.Params.AddItem('fields', 'name,email', TRESTRequestParameterKind.pkGETorPOST);

    Request.Execute;

    if Response.StatusCode = 200 then
      Writeln(Response.Content);
  finally
    Response.Free;
    Request.Free;
    Client.Free;
  end;
end;

uses
  System.JSON;

var
  JSON: TJSONObject;
  Arr: TJSONArray;
  Item: TJSONObject;
  I: Integer;
begin
  // parse
  JSON := TJSONObject.ParseJSONValue('{"name":"Alice","age":30}') as TJSONObject;
  try
    Writeln(JSON.GetValue<string>('name'));
    Writeln(JSON.GetValue<Integer>('age'));
  finally
    JSON.Free;
  end;

  // build
  JSON := TJSONObject.Create;
  try
    JSON.AddPair('name', 'Bob');
    JSON.AddPair('scores', TJSONArray.Create(90, 85, 92));
  finally
    JSON.Free;
  end;
end;

// ServerContainerUnit1.pas
type
  TServerMethods1 = class(TDSServerModule)
    function GetUsers: TJSONArray;
    function GetUser(id: Integer): TJSONObject;
    [httppost] function CreateUser(Data: TJSONObject): TJSONObject;
  end;

function TServerMethods1.GetUsers: TJSONArray;
begin
  Result := TJSONArray.Create;
  // ... populate from DB ...
end;

// Access via URL:
//   GET  http://localhost:8080/datasnap/rest/TServerMethods1/GetUsers
//   GET  http://localhost:8080/datasnap/rest/TServerMethods1/GetUser/42
//   POST http://localhost:8080/datasnap/rest/TServerMethods1/CreateUser

uses
  IdHTTP, IdGlobal;

var
  Http: TIdHTTP;
  Response: string;
  PostData: TStringStream;
begin
  Http := TIdHTTP.Create(nil);
  try
    Http.Request.ContentType := 'application/json';
    Http.Request.CustomHeaders.AddValue('Authorization', 'Bearer token123');

    // GET
    Response := Http.Get('https://api.example.com/users');

    // POST
    PostData := TStringStream.Create('{"name":"Alice"}', TEncoding.UTF8);
    try
      Response := Http.Post('https://api.example.com/users', PostData);
    finally
      PostData.Free;
    end;

    Writeln(Http.ResponseCode);  // 200, 404, etc.
  finally
    Http.Free;
  end;
end;

uses
  System.Threading, REST.Client;

var
  Request: TRESTRequest;
begin
  Request := TRESTRequest.Create(nil);
  try
    Request.Client := TRESTClient.Create('https://api.example.com/users');
    Request.Client.Owner := Request;

    TTask.Run(
      procedure
      begin
        Request.Execute;  // background thread

        TThread.Queue(nil,
          procedure
          begin
            // update UI on main thread
            Memo1.Lines.Text := Request.Response.Content;
          end);
      end);
  finally
    // don't free Request here — task may still be running
  end;
end;

type
  TWorker = class(TThread)
  protected
    procedure Execute; override;
  public
    constructor Create;
  end;

procedure TWorker.Execute;
var
  I: Integer;
begin
  for I := 1 to 100 do
  begin
    if Terminated then Exit;
    // ... work ...
    Sleep(50);
  end;
end;

constructor TWorker.Create;
begin
  inherited Create(False);  // False = start immediately
  FreeOnTerminate := True;  // auto-free on completion
end;

uses
  System.Threading;

var
  Task: ITask;
  Future: IFuture<string>;
begin
  // fire-and-forget task
  Task := TTask.Create(
    procedure
    begin
      // ... background work ...
    end);
  Task.Start;

  // future — returns a value
  Future := TTask.Future<string>(
    function: string
    begin
      Sleep(1000);
      Result := 'computed value';
    end);

  // ... do other work ...

  Writeln(Future.Value);  // blocks until ready
end;

uses
  System.Threading, System.SyncObjs;

var
  Total: Integer;
  Lock: TCriticalSection;
  I: Integer;
begin
  Lock := TCriticalSection.Create;
  try
    TParallel.For(1, 1000,
      procedure(I: Integer)
      begin
        Lock.Enter;
        try
          Total := Total + ComputeExpensive(I);
        finally
          Lock.Leave;
        end;
      end);
  finally
    Lock.Free;
  end;
end;

uses
  System.SyncObjs;

var
  Lock: TCriticalSection;
  Event: TEvent;
  Count: Integer;
begin
  Lock := TCriticalSection.Create;
  Event := TEvent.Create(nil, True, False, '');
  try
    TThread.CreateAnonymousThread(
      procedure
      begin
        Lock.Enter;
        try
          Inc(Count);
        finally
          Lock.Leave;
        end;
        Event.SetEvent;  // signal completion
      end).Start;

    Event.WaitFor(INFINITE);  // wait for signal
  finally
    Lock.Free;
    Event.Free;
  end;
end;

// From a worker thread, update UI safely:

// Synchronous — blocks worker until main thread runs the code
TThread.Synchronize(nil,
  procedure
  begin
    Label1.Caption := 'Done';
  end);

// Asynchronous — posts to main thread queue, doesn't block
TThread.Queue(nil,
  procedure
  begin
    Label1.Caption := 'Progress: 50%';
  end);

// TThread.Queue is preferred for non-critical updates
// Synchronize for cases where you need the result before continuing

// MyPackage.dpk
package MyPackage;

{$R *.res}
{$ALIGN 8}
{$ASSERTIONS ON}
{$DESIGNONLY MyDesignUnits}  // design-time only
{$RUNONLY MyRuntimeUnits}    // runtime only

requires
  rtl,
  vcl,
  System.Generics.Collections;

contains
  MyUnit1 in 'MyUnit1.pas',
  MyUnit2 in 'MyUnit2.pas',
  MyComponent in 'MyComponent.pas';

end.

// Build configurations:
//   - Build (debug)
//   - Release
//   - Design-time (installs into IDE)
//   - Runtime (deployed with app)

unit MyLabel;

interface

uses
  Vcl.Controls, Vcl.Graphics, Vcl.StdCtrls;

type
  TMyLabel = class(TCustomLabel)
  private
    FHighlightColor: TColor;
    procedure SetHighlightColor(Value: TColor);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property HighlightColor: TColor
      read FHighlightColor write SetHighlightColor default clYellow;
    property Caption;
    property Font;
    property OnClick;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('MyPalette', [TMyLabel]);
end;

type
  TMyComponent = class(TComponent)
  private
    FItems: TStringList;
    function GetItems: TStrings;
    procedure SetItems(Value: TStrings);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Items: TStrings read GetItems write SetItems;
  end;

constructor TMyComponent.Create(AOwner: TComponent);
begin
  inherited;
  FItems := TStringList.Create;
end;

destructor TMyComponent.Destroy;
begin
  FItems.Free;
  inherited;
end;

// Property editor for rich editing in Object Inspector:
//   RegisterPropertyEditor(TypeInfo(TStrings), TMyComponent, 'Items',
//     TStringListProperty);

type
  TMyEvent = procedure(Sender: TObject; Value: Integer) of object;

  TMyComponent = class(TComponent)
  private
    FOnChange: TMyEvent;
  protected
    procedure DoChange(Value: Integer);
  published
    property OnChange: TMyEvent read FOnChange write FOnChange;
  end;

procedure TMyComponent.DoChange(Value: Integer);
begin
  if Assigned(FOnChange) then
    FOnChange(Self, Value);
end;

// 'of object' makes it a method pointer — must be assigned to a method
// (e.g., Form1.Button1Click). Always check Assigned before calling.

type
  TMySettings = class(TPersistent)
  private
    FTimeout: Integer;
    FTitle: string;
  published
    property Timeout: Integer read FTimeout write FTimeout default 30;
    property Title: string read FTitle write FTitle;
  end;

// TPersistent enables streaming (DFM, RTTI):
//   - Inherits from TPersistent (gives Assign)
//   - Published properties are streamed
//   - Override AssignTo/Assign for custom copy

// Save to DFM automatically:
//   - Component owned by a form is streamed
//   - Sub-properties (TPersistent) are nested in DFM
//   - Use DefineProperties for non-standard data

// Manual streaming:
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create('settings.bin', fmCreate);
  try
    Stream.WriteComponent(MyComponent);
  finally
    Stream.Free;
  end;
end;