variadic-arguments How to create a Delphi variadic method similar to Write/Writeln without requiring brackets for arguments?

[bravesofts 9]

I want to implement a variadic method in Delphi that behaves like Write and Writeln, where I can pass a variable number of arguments directly, without using brackets ([]) around the arguments.

For example, instead of calling a method like this:

MyWriteln(['Hello', 123, 45.67]); // Using array of const with brackets

I want to call it like this:

MyWriteln('Hello', 123, 45.67); // Without brackets, similar to Writeln

I found that Delphi supports varargs for external DLL functions declared with cdecl, like this:

procedure Test(aArgs: array of const); varargs; cdecl; external 'externalLibrary.dll';

However, since this approach is limited to external functions, I’d like to know if there’s any way to implement a similar variadic method directly in Delphi, avoiding the need for brackets around the arguments.

My main questions are:

1. How can I implement a Delphi variadic method that allows calling it without brackets, similar to Write/Writeln?
2. If it's only possible using varargs with external DLLs, how would I correctly declare and call such a method?

Any help or examples would be greatly appreciated!

-----

I’m working on a Delphi console application where I want to redirect the standard Write and Writeln output to a synchronized memo viewer in a separate VCL application. Here's a simplified version of my current setup:

unit Console.Output.MemoViewer;

interface

uses
  Winapi.Windows,
  System.SysUtils, System.Classes,
  System.SyncObjs,
  System.RTTI,
  System.Generics.Collections;

type

  TOutputViewer = class
  private
    fVCLAppPath: string;
    fStartupInfo: TStartupInfo;
    fProcessInfo: TProcessInformation;
    fLogFileName: string;
    fLogFileStream: TFileStream;
    fStreamWriter: TStreamWriter;
    fFileLock: TCriticalSection;

    procedure SetFileHiddenAttribute(const aFilePath: string);
    procedure ExtractVCLApp(const aResourceName: string; const aOutputPath: string);
    procedure LaunchVCLApp;
    procedure WaitForVCLAppClose;
    procedure WriteOutput(const aText: string);
  public
    constructor Create;
    destructor Destroy; override;

    procedure mWriteln(const aArgs: array of const);

    procedure HandleConsoleClose; stdcall;
  end;

implementation

{ TOutputViewer }

constructor TOutputViewer.Create;
begin
  fVCLAppPath  := ExtractFilePath(ParamStr(0))  + 'MemoViewer.exe';
  fLogFileName := 'ConsoleOutput.log';

  fFileLock := TCriticalSection.Create;

  // Extract and launch the VCL app
  ExtractVCLApp('MEMOVIEWER', fVCLAppPath);
  LaunchVCLApp;

  // Initialize the log file for writing output
  fLogFileStream := TFileStream.Create(fLogFileName, fmCreate or fmShareDenyNone);
  fStreamWriter := TStreamWriter.Create(fLogFileStream, TEncoding.UTF8);
end;

destructor TOutputViewer.Destroy;
begin
  fFileLock.Acquire;
  try
    FreeAndNil(fStreamWriter);
    FreeAndNil(fLogFileStream);
  finally
    fFileLock.Release;
    FreeAndNil(fFileLock);
  end;

  // Wait for VCL app to close and clean up
  WaitForVCLAppClose;
  inherited;
end;

procedure TOutputViewer.SetFileHiddenAttribute(const aFilePath: string);
var
  LFileAttr: DWORD;
begin
  LFileAttr := GetFileAttributes(PChar(aFilePath));
  if LFileAttr <> INVALID_FILE_ATTRIBUTES then
    SetFileAttributes(PChar(aFilePath), LFileAttr or FILE_ATTRIBUTE_HIDDEN);
end;

procedure TOutputViewer.ExtractVCLApp(const aResourceName: string; const aOutputPath: string);
var
  LResourceStream: TResourceStream;
  LFileStream: TFileStream;
begin
  if not FileExists(aOutputPath) then
  begin
    LResourceStream := TResourceStream.Create(HInstance, aResourceName, RT_RCDATA);
    try
      LFileStream := TFileStream.Create(aOutputPath, fmCreate);
      try
        LFileStream.CopyFrom(LResourceStream, LResourceStream.Size);
      finally
        LFileStream.Free;
      end;
    finally
      LResourceStream.Free;
    end;

    SetFileHiddenAttribute(aOutputPath);
  end;
end;

procedure TOutputViewer.LaunchVCLApp;
begin
  ZeroMemory(@fStartupInfo, SizeOf(fStartupInfo));
  fStartupInfo.cb := SizeOf(fStartupInfo);
  if not CreateProcess(nil, PChar(fVCLAppPath), nil, nil, False, 0, nil, nil, fStartupInfo, fProcessInfo) then
    RaiseLastOSError;
end;

procedure TOutputViewer.WaitForVCLAppClose;
begin
  WaitForSingleObject(fProcessInfo.hProcess, INFINITE);
  CloseHandle(fProcessInfo.hProcess);
  CloseHandle(fProcessInfo.hThread);

  if FileExists(fVCLAppPath) then
    DeleteFile(PChar(fVCLAppPath));
end;

procedure TOutputViewer.WriteOutput(const aText: string);
begin
  fFileLock.Acquire;
  try
    fStreamWriter.WriteLine(aText);
    fStreamWriter.Flush;
  finally
    fFileLock.Release;
  end;
end;

function VarRecToStr(const V: TVarRec): string;
begin
  case V.VType of
    vtInteger: Result := IntToStr(V.VInteger);
    vtBoolean: Result := BoolToStr(V.VBoolean, True);
    vtChar: Result := V.VChar;
    vtString: Result := string(V.VString^);
    vtAnsiString: Result := string(AnsiString(V.VAnsiString));
    vtWideString: Result := WideString(V.VWideString);
    vtUnicodeString: Result := string(UnicodeString(V.VUnicodeString));
    vtInt64: Result := IntToStr(V.VInt64^);
    else Result := '[Unknown]';
  end;
end;

procedure TOutputViewer.mWriteln(const aArgs: array of const);
var
  LText: string;
  LArg: TVarRec;
begin
  LText := '';

  for LArg in aArgs do
    LText := LText + Format('%s', [VarRecToStr(LArg)]) + ' ';
  WriteOutput(LText.Trim);
  writeln(LText.Trim);
end;

procedure TOutputViewer.HandleConsoleClose; stdcall;
begin
  TerminateProcess(fProcessInfo.hProcess, 0);
  WaitForVCLAppClose;
  Halt(0);
end;

end.

program ConsoleMemoViewer;

{$APPTYPE CONSOLE}


uses
  SysUtils,
  Console.Output.MemoViewer in 'API\Console.Output.MemoViewer.pas';

var
  Viewer: TOutputViewer;

begin
  try
    Viewer := TOutputViewer.Create;
    with Viewer do
    try
      mWriteln('Hello from redirected Writeln!:', 22, 35.7);
      mWriteln('This line uses redirected Write:', 22, ', Test 2: ', 35.7);
      mWriteln('Foo String: ', 22, ', Test 2: ', 35.7, 'Foo string:', 3333);
    finally
      Viewer.Free;
    end;
  except
    on E: Exception do
      Writeln('Error: ', E.Message);
  end;
end.

Currently, I'm using an array of const approach for mWriteln, but that requires enclosing the arguments in brackets, like this:

mWriteln(['Hello', 123, 45.67]); // Requires brackets

I’m aware of the overload solution where multiple versions of mWriteln can be created for different argument counts, but this is not practical when dealing with a large or unknown number of arguments.

Edited Monday at 11:37 AM by bravesofts

[Lajos Juhász 300]

16 minutes ago, bravesofts said:

How can I implement a Delphi variadic method that allows calling it without brackets, similar to Write/Writeln?

This has been done using compiler magic. You can not create such a function.

[Anders Melander 1820]

See also: http://rvelthuis.de/articles/articles-convert.html#varargs

[darnocian 91]

You can create vararg functions in Delphi - but not all compilers support it... 32bit Windows DCC32 only binds to external functions (so mapping onto functions exposed from external sources like .obj, .dll, etc)

 

I created a sample to illustrate that works on 12.2 using Win64 compiler... I havn't done a test on older compilers.

 

program VarArgsDemo;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.SysUtils;

function SumNumbers(const acount: integer): double; cdecl; varargs;
var
  LVAList: TVarArgList;
  i: integer;
begin
  result := 0;
  VarArgStart(LVAList);
  for i := 0 to acount - 1 do
    result := result + VarArgGetValue(LVAList, double);
  VarArgEnd(LVAList);
end;

begin
  try
    writeln(floattostr(SumNumbers(5, 1.1, 2.2, 3.3, 4.4, 5.5)));
  except
    on E: Exception do
      writeln(E.ClassName, ': ', E.Message);
  end;

end.

This relies on some magic TVarArgList, VarArgStart, VarArgGetValue, VarArgEnd

 

If you are familiar with C, you will note how these map onto the equivalents:  va_list, va_start, va_arg, va_end

 

So VarArgStart positions LVAList in the correct location on the stack so that subsequent calls to VarArgGetValue will extract the values from the stack. Note that it is up to you to come up with the logic to help VarArgGetValue reference the appropriate type so that the LVAlist increment is done appropriately. In my example, I've kept it simple, with the problem just summing ACount doubles. If you think about C's printf, where you may want to support different types like printf("%d %s %f\n", 10, "hello world", 42.123);  you would have to parse the string to then call something like VarArgGetValue(LVAList, integer), VarArgGetValue(LVAList, string), VarArgGetValue(LVAList, double) to extract the values to do something meaningful with them.

Edited Tuesday at 08:07 AM by darnocian

[darnocian 91]

Further, just talking about the safety concepts... I would classify using variadic behaviour with the va_* like functionality as unsafe, even if it is appealing, and possibly more optimal than having them wrapped by an 'array of const', where fields are encoded into a TVarRec etc, I'd rather stick to the pascal idiom as it is easier to loop through the parameters multiple times, query type information as you go , etc.

[bravesofts 9]

Temporary Solution:

By using Delphi's TValue type from the System.Rtti unit, I was able to implement a robust custom Writeln procedure usin overload. Here's how it works:

Main Procedure to Process Arguments

This procedure processes the arguments, determining their types and formatting them as needed:

procedure DoCustomWriteln(const Args: array of TValue);
var
  LArg: TValue;
  LOutput: string;
  I: Integer;
begin
  LOutput := '';
  for I := Low(Args) to High(Args) do
  begin
    LArg := Args[I];
    case LArg.Kind of
      tkInteger: LOutput := LOutput + IntToStr(LArg.AsInteger);
      tkFloat: LOutput := LOutput + FloatToStr(LArg.AsExtended);
      tkString, tkLString, tkUString, tkWString: LOutput := LOutput + LArg.AsString;
      tkChar, tkWChar: LOutput := LOutput + LArg.AsString;
      tkVariant:
        try
          LOutput := LOutput + VarToStr(LArg.AsVariant);
        except
          LOutput := LOutput + '<invalid variant>';
        end;
    else
      LOutput := LOutput + '<unsupported type>';
    end;

    // Add a separator unless it's the last argument
    if I < High(Args) then
      LOutput := LOutput + ', ';
  end;

  Writeln(LOutput);
end;

Overloading Writeln

To make calling this function straightforward without requiring brackets, I created multiple overloads for the CustomWriteln procedure:

procedure CustomWriteln(A1: TValue); overload;
begin
  DoCustomWriteln([A1]);
end;

procedure CustomWriteln(A1, A2: TValue); overload;
begin
  DoCustomWriteln([A1, A2]);
end;

procedure CustomWriteln(A1, A2, A3: TValue); overload;
begin
  DoCustomWriteln([A1, A2, A3]);
end;

// Add more overloads as needed for additional parameters

Test in Project:

begin
  try
    // Examples of usage with different types
    CustomWriteln(42);
    CustomWriteln(3.14, 'Hello');
    CustomWriteln(1, 2.2, 'Text', True);
    CustomWriteln(1, 'Two', 3.3, 'Four', False, 6);
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;

  Readln;
end.

 

Example Output

-------

42
3,14, Hello
1, 2,2, Text, <unsupported type>
1, Two, 3,3, Four, <unsupported type>, 6

Advantages of This Approach:

1. Flexible Input: Handles integers, floats, strings, characters, and variants.
2. Type-Safe: Uses TValue to handle types dynamically.
3. Scalable: Easy to extend by adding more overloads or enhancing DoCustomWriteln.

---

Final Project:

program CustomWritelnProj;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils, System.Variants,
  System.Math,
  System.Rtti;

procedure DoCustomWriteln(const Args: array of TValue);
var
  LArg: TValue;
  LOutput: string;
  I: Integer;
begin
  LOutput := '';
  for I := Low(Args) to High(Args) do
  begin
    LArg := Args[I];

    case LArg.Kind of
      tkInteger, tkInt64: LOutput := LOutput + LArg.AsInt64.ToString;
      tkFloat: LOutput := LOutput + LArg.AsExtended.ToString;
      tkEnumeration: LOutput := LOutput + BoolToStr(LArg.AsBoolean, True);

      tkString, tkLString, tkUString, tkWString,
      tkChar, tkWChar: LOutput := LOutput + LArg.AsString;
      tkVariant:
        try
          LOutput := LOutput + LArg.AsVariant.ToString;
        except
          LOutput := LOutput + '<invalid variant>';
        end;
    else
      LOutput := LOutput + '<unsupported type>';
    end;

    // Add a separator unless processing the last element
    if I < High(Args) then
      LOutput := LOutput + ', ';
  end;

  Writeln(LOutput);
end;

// Overloaded CustomWriteln implementations
procedure CustomWriteln(A1: TValue); overload;
begin
  DoCustomWriteln([A1]);
end;

procedure CustomWriteln(A1, A2: TValue); overload;
begin
  DoCustomWriteln([A1, A2]);
end;

procedure CustomWriteln(A1, A2, A3: TValue); overload;
begin
  DoCustomWriteln([A1, A2, A3]);
end;

procedure CustomWriteln(A1, A2, A3, A4: TValue); overload;
begin
  DoCustomWriteln([A1, A2, A3, A4]);
end;

procedure CustomWriteln(A1, A2, A3, A4, A5: TValue); overload;
begin
  DoCustomWriteln([A1, A2, A3, A4, A5]);
end;

procedure CustomWriteln(A1, A2, A3, A4, A5, A6: TValue); overload;
begin
  DoCustomWriteln([A1, A2, A3, A4, A5, A6]);
end;

procedure CustomWriteln(A1, A2, A3, A4, A5, A6, A7: TValue); overload;
begin
  DoCustomWriteln([A1, A2, A3, A4, A5, A6, A7]);
end;

procedure CustomWriteln(A1, A2, A3, A4, A5, A6, A7, A8: TValue); overload;
begin
  DoCustomWriteln([A1, A2, A3, A4, A5, A6, A7, A8]);
end;

procedure CustomWriteln(A1, A2, A3, A4, A5, A6, A7, A8, A9: TValue); overload;
begin
  DoCustomWriteln([A1, A2, A3, A4, A5, A6, A7, A8, A9]);
end;

begin
  try
    // Examples of usage with different types
    CustomWriteln(42);
    CustomWriteln(MaxComp,'The max value of Int64');
    CustomWriteln(MaxComp,MinComp, 'Int64 Interval');
    CustomWriteln(1, 2.2, 'Text', True);
    CustomWriteln(1, 'Two', 3.3, 'Four', False, 6);
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;

  Readln;
end.

 

Edited Tuesday at 05:53 PM by bravesofts