Произвольный массив для Format() на примере TStringList


Более-менее корректный способ передачи произвольных данных в функцию Format(),
которая, как известно, принимает array of const
(Но это можно исправить)

program project1;

{$APPTYPE CONSOLE}

uses
  Classes, SysUtils, Variants;



  type
    TConstArray = array of TVarRec;

  // Copies a TVarRec and its contents. If the content is referenced
  // the value will be copied to a new location and the reference
  // updated.
  function CopyVarRec(const Item: TVarRec): TVarRec;
  var
    W: WideString;
  begin
    // Copy entire TVarRec first
    Result := Item;
    // Now handle special cases
    case Item.VType of
      vtExtended:
        begin
          New(Result.VExtended);
          Result.VExtended^ := Item.VExtended^;
        end;
      vtString:
        begin
          // Improvement suggestion by Hallvard Vassbotn: only copy real length.
          GetMem(Result.VString, Length(Item.VString^) + 1);
          Result.VString^ := Item.VString^;
        end;
      vtPChar:
        Result.VPChar := StrNew(Item.VPChar);
      // There is no StrNew for PWideChar
      vtPWideChar:
        begin
          W := Item.VPWideChar;
          GetMem(Result.VPWideChar,
                 (Length(W) + 1) * SizeOf(WideChar));
          Move(PWideChar(W)^, Result.VPWideChar^,
               (Length(W) + 1) * SizeOf(WideChar));
        end;
      // A little trickier: casting to AnsiString will ensure
      // reference counting is done properly.
      vtAnsiString:
        begin
          // nil out first, so no attempt to decrement reference count.
          Result.VAnsiString := nil;
          AnsiString(Result.VAnsiString) := AnsiString(Item.VAnsiString);
        end;
      vtCurrency:
        begin
          New(Result.VCurrency);
          Result.VCurrency^ := Item.VCurrency^;
        end;
      vtVariant:
        begin
          New(Result.VVariant);
          Result.VVariant^ := Item.VVariant^;
        end;
      // Casting ensures proper reference counting.
      vtInterface:
        begin
          Result.VInterface := nil;
          IInterface(Result.VInterface) := IInterface(Item.VInterface);
        end;
      // Casting ensures a proper copy is created.
      vtWideString:
        begin
          Result.VWideString := nil;
          WideString(Result.VWideString) := WideString(Item.VWideString);
        end;
      vtInt64:
        begin
          New(Result.VInt64);
          Result.VInt64^ := Item.VInt64^;
        end;
      vtUnicodeString:
        begin
          // Similar to AnsiString.
          Result.VUnicodeString := nil;
          UnicodeString(Result.VUnicodeString) := UnicodeString(Item.VUnicodeString);
        end;
      // VPointer and VObject don't have proper copy semantics so it
      // is impossible to write generic code that copies the contents
    end;
  end;

  function CreateConstArray(const Elements: array of const): TConstArray;
  var
    I: Integer;
  begin
    SetLength(Result, Length(Elements));
    for I := Low(Elements) to High(Elements) do
      Result[I] := CopyVarRec(Elements[I]);
  end;

  function CreateConstArray(L:TStringList): TConstArray;
  var
    I: Integer;
    s: string;
    V: TVarRec;
  begin
    SetLength(Result, L.Count);
    for I := 0 to L.Count-1 do
    begin
      s:=L.Strings[i];
      V.VType := vtAnsiString;
      V.VAnsiString := pointer(s);
      Result[I] := CopyVarRec(V);
    end;
  end;

  // use this function on copied TVarRecs only!
  procedure FinalizeVarRec(var Item: TVarRec);
  begin
    case Item.VType of
      vtExtended:
        Dispose(Item.VExtended);
      vtString:
        Dispose(Item.VString);
      vtPChar:
        StrDispose(Item.VPChar);
      vtPWideChar:
        FreeMem(Item.VPWideChar);
      vtAnsiString:
        AnsiString(Item.VAnsiString) := '';
      vtCurrency:
        Dispose(Item.VCurrency);
      vtVariant:
        Dispose(Item.VVariant);
      vtInterface:
        IInterface(Item.VInterface) := nil;
      vtWideString:
        WideString(Item.VWideString) := '';
      vtInt64:
        Dispose(Item.VInt64);
      vtUnicodeString:
        UnicodeString(Item.VUnicodeString) := '';
    end;
    Item.VInteger := 0;
  end;

  // A TConstArray contains TVarRecs that must be finalized. This function
  // does that for all items in the array.
  procedure FinalizeConstArray(var Arr: TConstArray);
  var
    I: Integer;
  begin
    for I := Low(Arr) to High(Arr) do
      FinalizeVarRec(Arr[I]);
    Arr := nil;
  end;


var
  ConstArray: TConstArray;
  LArray: TConstArray;
  L:TStringList;

begin
  L:=TStringList.Create;
  L.Add('5.5');
  L.Add('BCA');
  ConstArray := CreateConstArray([1, 'Hello', 7.9, IntToStr(1234)]);
  LArray:=CreateConstArray(L);
  try
    WriteLn('TEST1 '+ Format('%s / %s', LArray));
    WriteLn('TEST2 '+ Format('%d --- %s --- %0.2f --- %s', ConstArray));
    Writeln('TEST3 '+ Format('%s --- %0.2f', Copy(ConstArray, 1, 2)));
  finally
    FinalizeConstArray(ConstArray);
    FinalizeConstArray(LArray);
  end;
  ReadLn;
  L.Free;
end.


Недостаток данного кода заключается в том, что '5.5' - это не число,
а строка, и форматируется по правилам строки, т.е.
выровнять нули так не получится.