English Deutsch

Delphi Tips

Writing software is my daily job since several years, but at at the same time it's still a hobby for me. Most of the applications i made, were written in Borland Delphi, i like the cleanness and consistence of this language.

Very often programmers stumble across the same problems, sometimes depending on the programming environment. To prevent myself from doing it more than once with the same problem, i decided to start this page with some code snippets and share it with other peoples with the same interests. The functions are all free and tested and most of them are written by myself. You can use them in your own applications, but this shouldn't prevent you from understanding what the code does ;-).

If you should have problems, questions or suggestions about the functions below, or if you simply find them useful, don't hesitate to send me an email to .

Overview


Application functions

Filename of the application (exe/dll)

To get the filename of the application, most of the time you can call:

sFileName := Application.ExeName;
// or
sFileName := ParamStr(0);

Perhaps you are working on a DLL and are interested in the filename of the DLL rather than the filename of the application, then you can use this function:

uses SysUtils;

sFileName := GetModuleName(HInstance); // returns the Dll name
sFileName := GetModuleName(0); // returns the Exe name

Version of the application

With this function you can get the version of a file, which contains a version resource. This way you can display the version number of your application in an information dialog. To include a version resource to your Delphi application, set the "Versioninfo" in the project options.

uses Windows, SysUtils;

/// <summary>
///   This function reads the file resource of "FileName" and returns
///   the version number as formatted text.</summary>
/// <example>
///   Sto_GetFmtFileVersion() = '4.13.128.0'
///   Sto_GetFmtFileVersion('', '%.2d-%.2d-%.2d') = '04-13-128'
/// </example>
/// <remarks>If "Fmt" is invalid, the function may raise an
///   EConvertError exception.</remarks>
/// <param name="FileName">Full path to exe or dll. If an empty
///   string is passed, the function uses the filename of the
///   running exe or dll.</param>
/// <param name="Fmt">Format string, you can use at most four integer
///   values.</param>
/// <returns>Formatted version number of file, '' if no version
///   resource found.</returns>
function Sto_GetFmtFileVersion(const FileName: String = '';
  const Fmt: String = '%d.%d.%d.%d'): String;
var
  sFileName: String;
  iBufferSize: DWORD;
  iDummy: DWORD;
  pBuffer: Pointer;
  pFileInfo: Pointer;
  iVer: array[1..4] of Word;
begin
  // set default value
  Result := '';
  // get filename of exe/dll if no filename is specified
  sFileName := FileName;
  if (sFileName = '') then
  begin
    // prepare buffer for path and terminating #0
    SetLength(sFileName, MAX_PATH + 1);
    SetLength(sFileName,
      GetModuleFileName(hInstance, PChar(sFileName), MAX_PATH + 1));
  end;
  // get size of version info (0 if no version info exists)
  iBufferSize := GetFileVersionInfoSize(PChar(sFileName), iDummy);
  if (iBufferSize > 0) then
  begin
    GetMem(pBuffer, iBufferSize);
    try
    // get fixed file info (language independent)
    GetFileVersionInfo(PChar(sFileName), 0, iBufferSize, pBuffer);
    VerQueryValue(pBuffer, '\', pFileInfo, iDummy);
    // read version blocks
    iVer[1] := HiWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionMS);
    iVer[2] := LoWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionMS);
    iVer[3] := HiWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionLS);
    iVer[4] := LoWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionLS);
    finally
      FreeMem(pBuffer);
    end;
    // format result string
    Result := Format(Fmt, [iVer[1], iVer[2], iVer[3], iVer[4]]);
  end;
end;

Starting an external application

For starting an external application, you can use the WindowsAPI function ShellExecute.

Often it is better to pass nil (instead of 'open') as the operation keyword, Windows will then use the default keyword, or 'open' if the default keyword is not defined. With nil it works like a doubleclick in the explorer.

uses ShellApi;

ShellExecute(0, nil, 'calc.exe', '', '', SW_SHOWNORMAL);

Sometimes you need more control over the starting process, perhaps you want to wait until the process has finished or you need the exit code of the application.

uses Windows, ShellApi;

/// <summary>
///   Executes an external program or opens a document with its
///   standard application.</summary>
/// <param name="FileName">Full path of application or document.</param>
/// <param name="Parameters">Command line arguments.</param>
/// <param name="ExitCode">Exitcode of application (only avaiable
///   if Wait > 0).</param>
/// <param name="Wait">[milliseconds] Maximum of time to wait,
///   until application has finished. After reaching this timeout,
///   the application will be terminated and False is returned as
///   result. 0 = don't wait on application, return immediately.</param>
/// <param name="Hide">If True, application runs invisible in the
///   background.</param>
/// <returns>True if application could be started successfully, False
///   if app could not be started or timeout was reached.</returns>
function Sto_ShellExecute(const FileName, Parameters: String;
  var ExitCode: DWORD; const Wait: DWORD = 0;
  const Hide: Boolean = False): Boolean;
var
  myInfo: SHELLEXECUTEINFO;
  iWaitRes: DWORD;
begin
  // prepare SHELLEXECUTEINFO structure
  ZeroMemory(@myInfo, SizeOf(SHELLEXECUTEINFO));
  myInfo.cbSize := SizeOf(SHELLEXECUTEINFO);
  myInfo.fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_NO_UI;
  myInfo.lpFile := PChar(FileName);
  myInfo.lpParameters := PChar(Parameters);
  if Hide then
    myInfo.nShow := SW_HIDE
  else
    myInfo.nShow := SW_SHOWNORMAL;
  // start file
  ExitCode := 0;
  Result := ShellExecuteEx(@myInfo);
  // if process could be started
  if Result then
  begin
    // wait on process ?
    if (Wait > 0) then
    begin
      iWaitRes := WaitForSingleObject(myInfo.hProcess, Wait);
      // timeout reached ?
      if (iWaitRes = WAIT_TIMEOUT) then
      begin
        Result := False;
        TerminateProcess(myInfo.hProcess, 0);
      end;
      // get the exitcode
      GetExitCodeProcess(myInfo.hProcess, ExitCode);
    end;
    // close handle, because SEE_MASK_NOCLOSEPROCESS was set
    CloseHandle(myInfo.hProcess);
  end;
end;

To wait until the application has been started (instead of finished), replace "WaitForSingleObject" with "WaitForInputIdle".

Starting console application and redirect stdoutput

Most console applications send their output to the stdoutput and stderror devices and these are normally connected to the display. You can start such an application and capture its output, to read and interpret it in your own application. To avoid the disadvantages of the filesystem and permission problems, it's best to redirect to pipes and read from them.

For a full example, of how to start the "cmd.exe" and using input pipe as well as output pipes, you can download this small example project StoRedirectedExecute.zip.

uses Windows, Classes;

type
  TStoReadPipeThread = class(TThread)
  protected
    FPipe: THandle;
    FContent: TStringStream;
    function Get_Content: String;
    procedure Execute; override;
  public
    constructor Create(const Pipe: THandle);
    destructor Destroy; override;
    property Content: String read Get_Content;
  end;

constructor TStoReadPipeThread.Create(const Pipe: THandle);
begin
  FPipe := Pipe;
  FContent := TStringStream.Create('');
  inherited Create(False); // start immediately
end;

destructor TStoReadPipeThread.Destroy;
begin
  FContent.Free;
  inherited Destroy;
end;

procedure TStoReadPipeThread.Execute;
const
  BLOCK_SIZE = 4096;
var
  iBytesRead: DWORD;
  myBuffer: array[0..BLOCK_SIZE-1] of Byte;
begin
  repeat
    // try to read from pipe
    if ReadFile(FPipe, myBuffer, BLOCK_SIZE, iBytesRead, nil) then
      FContent.Write(myBuffer, iBytesRead);
    // a process may write less than BLOCK_SIZE, even if not at the end
    // of the output, so checking for < BLOCK_SIZE would block the pipe.
  until (iBytesRead = 0);
end;

function TStoReadPipeThread.Get_Content: String;
begin
  Result := FContent.DataString;
end;

/// <summary>
///   Runs a console application and captures the stdoutput and
///   stderror.</summary>
/// <param name="CmdLine">The commandline contains the full path to
///   the executable and the necessary parameters.
/// <param name="Output">Receives the console stdoutput.</param>
/// <param name="Error">Receives the console stderror.</param>
/// <param name="Wait">[milliseconds] Maximum of time to wait,
///   until application has finished. After reaching this timeout,
///   the application will be terminated and False is returned as
///   result.</param>
/// <returns>True if process could be started and did not reach the
///   timeout.</returns>
function Sto_RedirectedExecute(CmdLine: String;
  var Output, Error: String; const Wait: DWORD = 3600000): Boolean;
var
  mySecurityAttributes: SECURITY_ATTRIBUTES;
  myStartupInfo: STARTUPINFO;
  myProcessInfo: PROCESS_INFORMATION;
  hPipeOutputRead, hPipeOutputWrite: THandle;
  hPipeErrorRead, hPipeErrorWrite: THandle;
  myReadOutputThread: TStoReadPipeThread;
  myReadErrorThread: TStoReadPipeThread;
  iWaitRes: Integer;
begin
  // prepare security structure
  ZeroMemory(@mySecurityAttributes, SizeOf(SECURITY_ATTRIBUTES));
  mySecurityAttributes.nLength := SizeOf(SECURITY_ATTRIBUTES);
  mySecurityAttributes.bInheritHandle := TRUE;
  // create pipes to get stdoutput and stderror
  CreatePipe(hPipeOutputRead, hPipeOutputWrite, @mySecurityAttributes, 0);
  CreatePipe(hPipeErrorRead, hPipeErrorWrite, @mySecurityAttributes, 0);

  // prepare startupinfo structure
  ZeroMemory(@myStartupInfo, SizeOf(STARTUPINFO));
  myStartupInfo.cb := Sizeof(STARTUPINFO);
  // hide application
  myStartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  myStartupInfo.wShowWindow := SW_HIDE;
  // assign pipes
  myStartupInfo.dwFlags := myStartupInfo.dwFlags or STARTF_USESTDHANDLES;
  myStartupInfo.hStdInput := 0;
  myStartupInfo.hStdOutput := hPipeOutputWrite;
  myStartupInfo.hStdError := hPipeErrorWrite;

  // since Delphi calls CreateProcessW, literal strings cannot be used anymore
  UniqueString(CmdLine);

  // start the process
  Result := CreateProcess(nil, PChar(CmdLine), nil, nil, True,
    CREATE_NEW_CONSOLE, nil, nil, myStartupInfo, myProcessInfo);
  // close the ends of the pipes, now used by the process
  CloseHandle(hPipeOutputWrite);
  CloseHandle(hPipeErrorWrite);

  // could process be started ?
  if Result then
  begin
    myReadOutputThread := TStoReadPipeThread.Create(hPipeOutputRead);
    myReadErrorThread := TStoReadPipeThread.Create(hPipeErrorRead);
    try
    // wait unitl there is no more data to receive, or the timeout is reached
    iWaitRes := WaitForSingleObject(myProcessInfo.hProcess, Wait);
    // timeout reached ?
    if (iWaitRes = WAIT_TIMEOUT) then
    begin
      Result := False;
      TerminateProcess(myProcessInfo.hProcess, UINT(ERROR_CANCELLED));
    end;
    // return output
    myReadOutputThread.WaitFor;
    Output := myReadOutputThread.Content;
    myReadErrorThread.WaitFor;
    Error := myReadErrorThread.Content;
    finally
      myReadOutputThread.Free;
      myReadErrorThread.Free;
      CloseHandle(myProcessInfo.hThread);
      CloseHandle(myProcessInfo.hProcess);
    end;
  end;
  // close our ends of the pipes
  CloseHandle(hPipeOutputRead);
  CloseHandle(hPipeErrorRead);
end;

Each "ReadFile" operation on a pipe will block, until there is either data to read, or the handle of the pipe is closed (no more data). An application who sends data to the pipe will fill up the buffer and block until someone reads the data at the other end of the pipe. This means, if we read more than one pipe, each pipe can block the others, so for a safe implementation we have to use threads to read the pipes.

For creating a link in your application, e.g. on the info dialog, you can use the following procedures.

uses ShellApi, SysUtils;

function Sto_UrlEncode(const Text: String): String;
var
  iPos: Integer;
  cCharacter: Char;
begin
  Result := Text;
  // search for not web save characters
  for iPos := Length(Result) downto 1 do
  begin
    cCharacter := Result[iPos];
    if (not (cCharacter in ['A'..'Z', 'a'..'z', '0'..'9'])) then
    begin
      Delete(Result, iPos, 1);
      Insert('%' + IntToHex(Ord(cCharacter), 2), Result, iPos);
    end;
  end;
end;

procedure Sto_OpenMail(const Address: String; const Subject: String = '';
  const Body: String = ''; const Cc: String = ''; const Bcc: String = '');
var
  slParameters: TStrings;
  sMailCommand: String;
  iParameter: Integer;
begin
  slParameters := TStringList.Create;
  try
  if (Subject <> '') then
    slParameters.Add('subject=' + Sto_UrlEncode(Subject));
  if (Body <> '') then
    slParameters.Add('body=' + Sto_UrlEncode(Body));
  if (Cc <> '') then
    slParameters.Add('cc=' + Cc);
  if (Bcc <> '') then
    slParameters.Add('bcc=' + Bcc);
  // bring parameters into a form like:
  // mailto:<address>?subject=<subjectline>&body=<mailtext>&cc=<address>&bcc=<address>
  sMailCommand := 'mailto:' + Address;
  for iParameter := 0 to slParameters.Count - 1 do
  begin
    if (iParameter = 0) then
      sMailCommand := sMailCommand + '?'
    else
      sMailCommand := sMailCommand + '&';
    sMailCommand := sMailCommand + slParameters.Strings[iParameter];
  end;
  ShellExecute(0, 'open', PChar(sMailCommand), nil, nil, SW_SHOWNORMAL);
  finally
    slParameters.Free;
  end;
end;

procedure Sto_OpenWebSite(const Site: String);
begin
  ShellExecute(0, 'open', PChar(Site), nil, nil, SW_SHOWNORMAL);
end;

Command line parameters

To get the command line parameters passed at the application start, you can use the functions "ParamCount" and "ParamStr". The first parameter 0 contains the application filename, the same as you can get with "Application.ExeName".

////////////////////////////////////////////////////////////////
// in this example, the application was started with 3
// parameters ('Good', 'evening' and 'Delphi').
procedure Sto_CommandLineDemo;
var
  iParamCount: Integer;
  sApplication: String;
  sParam1, sParam2, sParam3: String;
begin
  iParamCount := ParamCount;   // iParamCount = 3
  sApplication := ParamStr(0); // sApplication = filename of application
  sParam1 := ParamStr(1);      // sParam1 = 'Good'
  sParam2 := ParamStr(2);      // sParam2 = 'evening'
  sParam3 := ParamStr(3);      // sParam3 = 'Delphi'
end;

If you need the complete command line (e.g. for a special parsing), then you can use the global variable "CmdLine" or the Windows API function "GetCommandLine" and get all parameters in one string.

Including external resources like a cursor

There are several ways to load resources into your project, you could for example generate a compiled resource file (*.res) and include it to your project or you could load the ressource at runtime from a file. Both cases have drawbacks: to create a (*.res) file you need a tool like Delphi's image editor which is very limited, and loading the resource at runtime you have to deliver the resource file and make sure it exists when needed.

Fortunately there is an other method which can include resources from external files to your exe at compiletime. This example shows, how to include a cursor (sto_cursor.cur) to your project, in the example all files are placed in the Delphi project directory.

Now we have to fill the resource script, the example shows an include of the file (sto_cursor.cur). At the begin of the line has to be the id of the resource (my_cursor), it is defined by yourself. The id is followed by a keyword (CURSOR), which describes the type of the resource, and the third parameter is the filename.

my_cursor CURSOR "sto_cursor.cur"

After this is done, you can build your project and the resource will be compiled (sto_cursor.res) and added to the exe. To display the new cursor, you first have to load the resource. In the example, the unused cursor "crSqlWait" will be replaced by our cursor. Normally you would have to unload a resource loaded with "LoadImage" but in this case "Screen.Cursor" will handle this for you.
Note: the function "LoadCursor" has been superseded by "LoadImage".

const
  crMyCursor = crSqlWait; // replace an unneeded cursor

procedure TForm1.FormCreate(Sender: TObject);
begin
  // load the own cursor with id "my_cursor" and replace one of the existing cursors
  Screen.Cursors[crMyCursor] := LoadImage(HInstance, 'my_cursor', IMAGE_CURSOR, 0, 0, 0);
end;

In a last step, you can show your cursor.

procedure TForm1.Button1Click(Sender: TObject);
begin
  Screen.Cursor := crMyCursor;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Screen.Cursor := crDefault;
end;

File & path functions

Often used file functions

You don't remember exactly the functionname, but you know there was a function...?

Get long filename from a short DOS filename

To get the short DOS filename, Delphi offers the function "ExtractShortPathName", to get the long filename from a DOS filename you can use the following function:

uses Windows, ShlObj, ActiveX;

////////////////////////////////////////////////////////////////
// this function returns the long path from a short 8.3 DOS path.
// if it was not possible to get the long path, the function gives
// back "ShortPathName" as the result.
function Sto_ExtractLongPathName(const ShortPathName: String): String;
var
  bSuccess: Boolean;
  fncGetLongPathName: function (lpszShortPath: LPCTSTR;
    lpszLongPath: LPTSTR; cchBuffer: DWORD): DWORD stdcall;
  szBuffer: array[0..MAX_PATH] of Char;
  pDesktop: IShellFolder;
  swShortPath: WideString;
  iEaten: ULONG;
  pItemList: PItemIDList;
  iAttributes: ULONG;
begin
  bSuccess := False;
  // try to use the function "GetLongPathNameA" (Win98/2000 and up)
  @fncGetLongPathName := GetProcAddress(
    GetModuleHandle('Kernel32.dll'), 'GetLongPathNameA');
  if (Assigned(fncGetLongPathName)) then
  begin
    bSuccess := fncGetLongPathName(PChar(ShortPathName), szBuffer,
      SizeOf(szBuffer)) <> 0;
    if bSuccess then
      Result := szBuffer;
  end;
  // use an alternative way of getting the path (Win95/NT). the function
  // "SHGetFileInfo" (as often seen in examples) only converts the
  // filename without the path.
  if (not bSuccess) and Succeeded(SHGetDesktopFolder(pDesktop)) then
  begin
    swShortPath := ShortPathName;
    iAttributes := 0;
    if Succeeded(pDesktop.ParseDisplayName(0, nil, POLESTR(swShortPath),
      iEaten, pItemList, iAttributes)) then
    begin
      bSuccess := SHGetPathFromIDList(pItemList, szBuffer);
      if bSuccess then
        Result := szBuffer;
      // release ItemIdList (SHGetMalloc is superseded)
      CoTaskMemFree(pItemList);
    end;
  end;
  // give back the original path if unsuccessful
  if (not bSuccess) then
    Result := ShortPathName;
end;

Get the size of a file (more than 2 GB)

With this function you can receive the size of a file, it still works correctly with sizes larger than 2 GB.

uses SysUtils;

////////////////////////////////////////////////////////////////
// this function determines the size of a file in bytes, the size
// can be more than 2 GB.
function Sto_GetFileSize(const FileName: String): Int64;
var
  myFile: THandle;
  myFindData: TWin32FindData;
begin
  // set default value
  Result := 0;
  // get the file handle.
  myFile := FindFirstFile(PChar(FileName), myFindData);
  if (myFile <> INVALID_HANDLE_VALUE) then
  begin
    Windows.FindClose(myFile);
    Int64Rec(Result).Lo := myFindData.nFileSizeLow;
    Int64Rec(Result).Hi := myFindData.nFileSizeHigh;
  end;
end;

Directory browse dialog

To browse for a file you can use the TOpenFile dialog, to browse for a directory there is a function "SelectDirectory". If you want to pre-select a node in the tree, don't use the "RootNode", use the "Directory" parameter instead. (Delphi6)

uses FileCtrl;

////////////////////////////////////////////////////////////////
// opens the directory browse dialog with a pre-selected node.
procedure TForm1.Button1Click(Sender: TObject);
var
  sDirectory: String;
begin
  sDirectory := 'C:\Program Files';
  if SelectDirectory('Text above the tree', '', sDirectory) then
    ShowMessage(sDirectory);
end;

Moving files and directories to the recyclebin

"SHFileOperation" is a multipurpose function and can be used to copy, move, rename and delete files and directories. You can make use of the standard confirmation messages and the progress dialog of Windows.

uses SysUtils, ShellApi;

////////////////////////////////////////////////////////////////
// - "Filenames" is a list of files and directories you want to delete.
//   the user will be asked for confirmation and the progress dialog will
//   be displayed if necessary.
// - "ParentWindow" is the parent window for message boxes, you can pass "0".
// after executing, you have to check, which files where really deleted,
// because the user can cancel the deleting procedure.
procedure Sto_DeleteFiles(const ParentWindow: HWND; const Filenames: TStrings;
  const ToRecycleBin: Boolean = True);
var
  iFile: Integer;
  sFilenames: String;
  myFileOp: SHFILEOPSTRUCT;
begin
  if (Filenames.Count = 0) then Exit;
  // create a #0 delimited string with two trailing #0
  sFilenames := '';
  for iFile := 0 to Filenames.Count - 1 do
    sFilenames := sFilenames + ExcludeTrailingPathDelimiter(Filenames.Strings[iFile]) + #0;
  sFilenames := sFilenames + #0;
  // prepare the SHFILEOPSTRUCT
  FillChar(myFileOp, SizeOf(myFileOp), 0);
  myFileOp.Wnd := ParentWindow;
  myFileOp.wFunc := FO_DELETE;
  myFileOp.pFrom := PChar(sFilenames);
  // could be moved to the recyclebin, even if "ToRecycleBin" is false.
  if ToRecycleBin then
    myFileOp.fFlags := myFileOp.fFlags or FOF_ALLOWUNDO;
  SHFileOperation(myFileOp);
end;

Searching a directory

You can use this code as a base to your own procedure, the procedure lists the content of a direcotry.

uses Classes, SysUtils;

////////////////////////////////////////////////////////////////
// "Directory": will be searched for files and directories, the results will
//   be added with the full path to "List". directories are written with a
//   trailing "\" at the end.
// "Mask": can contain one or several masks, delimited with a semikolon. to
//   ignore directory names, add an extension to the mask. for more detailed
//   information see the delphi function "FindFirst".
// "Recursive": if true, subdirectories will be searched too.
// "Append": if true, existing entries remain in "List".
procedure Sto_SearchDirectory(List: TStrings; const Directory: String;
  const Mask: String = '*.*'; Recursive: Boolean = True;
  Append: Boolean = False);

  procedure _SearchDirectory(List: TStrings; const DelimitedDirectory: String;
    Masks: TStrings; Recursive: Boolean);
  var
    iMaskIndex: Integer;
    bFoundFile: Boolean;
    mySearchRec: TSearchRec;
    sFile, sDirectory: String;
  begin
    // list files and directories
    for iMaskIndex := 0 to Masks.Count - 1 do
    begin
      bFoundFile := FindFirst(DelimitedDirectory + Masks[iMaskIndex],
        faAnyFile, mySearchRec) = 0;
      while (bFoundFile) do
      begin
        // skip "." and ".."
        if (mySearchRec.Name <> '.') and (mySearchRec.Name <> '..') then
        begin
          sFile := DelimitedDirectory + mySearchRec.Name;
          // add delimiter to directories
          if ((mySearchRec.Attr and faDirectory) <> 0) then
            sFile := IncludeTrailingPathDelimiter(sFile);
          // add to list
          List.Add(sFile);
        end;
        // find next file
        bFoundFile := FindNext(mySearchRec) = 0;
      end;
      FindClose(mySearchRec);
    end;
    // recursive call for directories
    if (Recursive) then
    begin
      bFoundFile := FindFirst(DelimitedDirectory + '*', faDirectory,
        mySearchRec) = 0;
      while (bFoundFile) do
      begin
        // skip "." and ".."
        if (mySearchRec.Name <> '.') and (mySearchRec.Name <> '..') then
        begin
          sDirectory := IncludeTrailingPathDelimiter(DelimitedDirectory +
            mySearchRec.Name);
          _SearchDirectory(List, sDirectory, Masks, Recursive);
        end;
        // find next directory
        bFoundFile := FindNext(mySearchRec) = 0;
      end;
      FindClose(mySearchRec);
    end;
  end;

var
  slMasks: TStringList;
begin
  // prepare list
  if (not Append) then
    List.Clear;
  List.BeginUpdate;
  slMasks := TStringList.Create;
  try
  // prepare masks
  if (Mask = '') then
    slMasks.Add('*')
  else
  begin
    slMasks.Delimiter := ';';
    slMasks.DelimitedText := Mask;
  end;
  // start recursive loop
  _SearchDirectory(List, IncludeTrailingPathDelimiter(Directory),
    slMasks, Recursive);
  finally
    slMasks.Free;
    List.EndUpdate;
  end;
end;

How to copy filenames from/to the clipboard

When you use the copy function in the explorer, you don't really copy the files to the clipboard, instead you pass the filenames. Reading the filenames is easily done, writing the filenames to the clipboard is a bit more tricky, but let's see.

uses Clipbrd, ShellApi, ShlObj, Windows, SysUtils;

////////////////////////////////////////////////////////////////
// copies filenames from the clipboard to "Filenames" if there
// are any. the clipboard can contain file- and directory names.
procedure Sto_PasteFilenamesFromClipboard(Filenames: TStrings);
var
  hDropHandle: HDROP;
  szBuffer: PChar;
  iCount, iIndex: Integer;
  iLength: Integer;
begin
  // check entry conditions
  if (Filenames = nil) then Exit;
  Filenames.Clear;
  // lock clipboard
  Clipboard.Open;
  try
  // does clipboard contain filenames?
  if (Clipboard.HasFormat(CF_HDROP)) then
  begin
    // get drop handle from the clipboard
    hDropHandle := Clipboard.GetAsHandle(CF_HDROP);
    // enumerate filenames
    iCount := DragQueryFile(hDropHandle, $FFFFFFFF, nil, 0);
    for iIndex := 0 to iCount - 1 do
    begin
      // get length of filename
      iLength := DragQueryFile(hDropHandle, iIndex, nil, 0);
      // allocate the memory, the #0 is not included in "iLength"
      szBuffer := StrAlloc(iLength + 1);
      try
      // get filename
      DragQueryFile(hDropHandle, iIndex, szBuffer, iLength + 1);
      Filenames.Add(szBuffer);
      finally // free the memory
        StrDispose(szBuffer);
      end;
    end;
  end;
  finally
    // unlock clipboard
    Clipboard.Close;
  end;
end;

////////////////////////////////////////////////////////////////
// copies filenames from "Filenames" to the clipboard.
// "Filenames" can contain file- and directory names.
function Sto_CopyFilenamesToClipboard(Filenames: TStrings): Boolean;
var
  sFilenames: String;
  iIndex: Integer;
  hBuffer: HGLOBAL;
  pBuffer: PDropFiles;
begin
  // check entry conditions
  Result := (Filenames <> nil) and (Filenames.Count > 0);
  if (not Result) then Exit;
  // bring the filenames in a form,
  // separated by #0 and ending with a double #0#0
  sFilenames := '';
  for iIndex := 0 to Filenames.Count - 1 do
    sFilenames := sFilenames +
      ExcludeTrailingPathDelimiter(Filenames.Strings[iIndex]) + #0;
  sFilenames := sFilenames + #0;
  // allocate memory with the size of the "DropFiles" structure plus the
  // length of the filename buffer.
  hBuffer := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT,
    SizeOf(DROPFILES) + Length(sFilenames));
  try
  Result := (hBuffer <> 0);
  if (Result) then
  begin
    pBuffer := GlobalLock(hBuffer);
    try
    // prepare the "DROPFILES" structure
    pBuffer^.pFiles := SizeOf(DROPFILES);
    // behind the "DROPFILES" structure we place the filenames
    pBuffer := Pointer(Integer(pBuffer) + SizeOf(DROPFILES));
    CopyMemory(pBuffer, PChar(sFilenames), Length(sFilenames));
    finally
      GlobalUnlock(hBuffer);
    end;
    // copy buffer to the clipboard
    Clipboard.Open;
    try
    Clipboard.SetAsHandle(CF_HDROP, hBuffer);
    finally
      Clipboard.Close;
    end;
  end;
  except
    Result := False;
    // free only if handle could not be passed to the clipboard
    GlobalFree(hBuffer);
  end;
end;

String functions

Often used string functions

You don't remember exactly the functionname, but you know there was a function...? (uses SysUtils, StrUtils, Classes).

Functionames Category
Length, Delete, Insert, Copy, StringReplace Standard procedures
Pos, PosEx, LastDelimiter Find substring
ExtractStrings, TStrings.CommaText, TStrings.DelimitedText Splitting strings
SameText, CompareStr, CompareText Compare strings
Trim, TrimLeft, TrimRight Remove whitespaces
UpperCase, LowerCase  
Format, FormatFloat, FormatDateTime Formatting
IntToStr, StrToInt, StrToIntDef, TryStrToInt, FloatToStr, StrToFloat, StrToFloatDef, TryStrToFloat Datatype conversion
StringOfChar, FillChar  

Working with PChar

Seldom you will have to use the string type PChar, though if you are working with the WindowsAPI or with C- Libraries you will have to. In contrast to the Delphi type "String", PChar is actually a pointer and you have to take care of the memory allocation.

If a function expects a variable of type PChar but does only read the variable (const parameter) you can work with normal strings and constant strings. In the example the windows function "MessageBox" expects two PChar arguments.

procedure SayHello;
var
  sNormalString: String;
begin
  sNormalString:= 'hello';
  MessageBox(0, PChar(sNormalString), 'ConstantString', MB_OK);
end;

If a function expects a PChar to place a result in it, then you have to allocate the memory yourself. After the function call it's very easy to convert the PChar to a String, you can simply assign the PChar to a String. In Delphi, the variable szBuffer (array of char) is compatible to PChar but with allocated memory.

function Sto_GetTempPathStatic: String;
var
  szBuffer: array[0..MAX_PATH] of Char;
begin
  GetTempPath(MAX_PATH + 1, szBuffer);
  Result := szBuffer; // copy all characters until first 0#
end;

The method above has two major drawbacks, first you have to know the necessary buffersize, and then you can run into an unpredictable situation, if a next version of the function accepts a bigger buffer. In this case the buffer would contain random data (although a missing #0 character wouldn't lead to a buffer overrun).

Of course there is a better way, and you can even work with normal strings. If you later have to switch to unicode, the code works the same way with WideStrings. Most Windows API functions will return the needed size shouldn't there be enough allocated memory, otherwise they return the length of the resulting string.

function Sto_GetTempPath: String;
var
  iAssumedSize, iSize: DWORD;
begin
  // try with a reasonable buffer size
  iAssumedSize := 80;
  SetLength(Result, iAssumedSize);
  iSize := GetTempPath(iAssumedSize, PChar(Result));
  // reserve more buffer if necessary
  if (iSize > iAssumedSize) then
  begin
    // in this case the terminating #0 is included in iSize.
    SetLength(Result, iSize);
    iSize := GetTempPath(iSize, PChar(Result));
  end;
  // reduce buffer to the effectively used size. if the api call
  // was successful, the terminating #0 is not included in iSize.
  SetLength(Result, iSize);
end;

Using text resources of Windows

Did you already write a small useful function for your library, but then it became difficult to share it, because you needed to deliver translated text resources? Maybe you can borrow the textes from the Windows environment, at least some of the most common textes. An overview of existing textes can give you a resource editor.

/// <summary>
///   Searches for a text resource in a Windows library.
///   Sometimes, using the existing Windows resources, you can
///   make your code language independent and you don't have to
///   care about translation problems.
/// </summary>
/// <example>
///   btnCancel.Caption := Sto_LoadWindowsStr('user32.dll', 801, 'Cancel');
///   btnYes.Caption := Sto_LoadWindowsStr('user32.dll', 805, 'Yes');
/// </example>
/// <param name="LibraryName">Name of the windows library like
///   'user32.dll' or 'shell32.dll'</param>
/// <param name="Ident">Id of the string resource.</param>
/// <param name="DefaultText">Return this text, if the resource
///   string could not be found.</param>
/// <returns>Desired string if the resource was found, otherwise
///   the DefaultText</returns>
function Sto_LoadWindowsStr(const LibraryName: String; const Ident: Integer;
  const DefaultText: String = ''): String;
const
  BUF_SIZE = 1024;
var
  hLibrary: THandle;
  iSize: Integer;
begin
  hLibrary := GetModuleHandle(PChar(LibraryName));
  if (hLibrary <> 0) then
  begin
    SetLength(Result, BUF_SIZE);
    iSize := LoadString(hLibrary, Ident, PChar(Result), BUF_SIZE);
    if (iSize > 0) then
      SetLength(Result, iSize)
    else
      Result := DefaultText;
  end
  else
    Result := DefaultText;
end;

ColorToHtml / HtmlToColor

In HTML, colors are stored as text in the RGB (red green blue) format. Each part of the color has a hex value with two digits. With the following functions you can convert a TColor value to an HTML-color-string and reverse.

uses SysUtils, Graphics;

////////////////////////////////////////////////////////////////
// converts a color to an html color string
// clRed => #FF0000
function Sto_ColorToHtml(const Color: TColor): String;
var
  iRgb: Longint;
  iHtml: Longint;
begin
  // convert system colors to rgb colors
  iRgb := ColorToRGB(Color);
  // change BBGGRR to RRGGBB
  iHtml := ((iRgb and $0000FF) shl 16) or // shift red to the left
           ( iRgb and $00FF00) or         // green keeps the place
           ((iRgb and $FF0000) shr 16);   // shift blue to the right
  // create the html string
  Result := '#' + IntToHex(iHtml, 6);
end;

////////////////////////////////////////////////////////////////
// converts an html color string to a color,
// can raise an EConvertError exception
// #0000FF -> clBlue
function Sto_HtmlToColor(Color: String): TColor;
var
  iHtml: Longint;
begin
  // remove the preceding '#'
  if (Length(Color) > 0) and (Color[1] = '#') then
    Delete(Color, 1, 1);
  // convert html string to integer
  iHtml := StrToInt('$' + Color);
  // change RRGGBB to BBGGRR
  Result := ((iHtml and $FF0000) shr 16) or // shift red to the right
            ( iHtml and $00FF00) or         // green keeps the place
            ((iHtml and $0000FF) shl 16);   // shift blue to the left
end;

Classes and objects

Writing events

You can write your own events in your classes. As soon as you place the event property in the "published" part of the class declaration, the Delphi IDE will show the event in the objectinspector by adding the component. It's a common practice to write a virtual method for calling the event, often it's called like the event with "Do" at the begin. In this example, the object passes a boolean parameter to the event, which can be altered in the event procedure. If you don't have to pass parameters you can use the predefined type "TNotifyEvent" instead of your own event declaration ("TOnEvent").

interface
type
  TOnEvent = procedure(Sender: TObject; var Continue: Boolean) of object;

  TEventDemo = class(TObject)
  protected
    FOnEvent: TOnEvent;
    procedure DoEvent; virtual;
  published
    property OnEvent: TOnEvent read FOnEvent write FOnEvent;
  end;

implementation

procedure TEventDemo.DoEvent;
var
  bContinue: Boolean;
begin
  // set default values
  bContinue := True;
  // call the event
  if Assigned(FOnEvent) then
    FOnEvent(Self, bContinue);
  // do other things
  if bContinue then
  begin
    // ...
  end;
end;

Index properties

A special kind of properties are the indexed properties, they act like an array and can be used in the same fashion. However, the class has to take care of the memory management and the performed actions by implementing the methods ("GetIndexProperty" and "SetIndexProperty").

interface
type
  TIndexPropertyDemo = class(TObject)
  protected
    function  GetIndexProperty(Index: Integer): String; virtual;
    procedure SetIndexProperty(Index: Integer; const Value: String); virtual;
  public
    property IndexProperty[Index: Integer]: String read GetIndexProperty write SetIndexProperty;
  end;

implementation

procedure IndexPropertyDemo(ExistingDemoObject: TIndexPropertyDemo);
var
  sText: String;
begin
  sText := ExistingDemoObject.IndexProperty[0];
  ExistingDemoObject.IndexProperty[1] := sText;
end;

Using windows messages

In Delphi classes, you can catch windows messages directly and use them for your own purposes. To do this, write a method and add the keyword "message" with the message id. It's normally not a virtual method because a child class can implement it in the same manner. To pass the message to an ancestor class, you can use the keyword "inherited".

In the example you can see a small class which implements a transparent panel. There are two methods implemented "WMEraseBkgnd" and "CreateParams", they show the difference between a normal virtual method (CreateParams) and a message handler (WMEraseBkgnd).

interface
uses Windows, Messages;

type
  TStoTransparentPanel = class(TWinControl)
  private
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  end;

implementation

procedure TStoTransparentPanel.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.ExStyle:= Params.ExStyle or WS_EX_TRANSPARENT;
end;

procedure TStoTransparentPanel.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  // in this case, we want to intercept the windows message. if we would want to
  // pass the message to the ancestor classes, we could use the keyword
  // "inherited" without the procedure name. example:
  //   inherited;
  Message.Result := 1;
end;

Delphi VCL

Coloring a StringGrid

You can bring colors to your grids with a small amount of work. A comfortable way to do this is, to write your own "OnDrawCell" event and paint the text manually. The example works with a TStringGrid, though it's not very different for TDrawGrid's.

////////////////////////////////////////////////////////////////
// draws the text for one single cell in a grid
procedure Sto_DrawCellText(const Canvas: TCanvas; const Rect: TRect;
  const Text: String; const BackColor, TextColor: TColor;
  const Alignment: TAlignment);
const
  BORDER_WIDTH = 2;
var
  iLeftBorder: Integer;
begin
  // calculate the left border
  iLeftBorder := 0;
  case Alignment of
    taLeftJustify : iLeftBorder := Rect.Left + BORDER_WIDTH;
    taRightJustify: iLeftBorder := Rect.Right - BORDER_WIDTH - Canvas.TextWidth(Text) -1;
    taCenter      : iLeftBorder := Rect.Left + (Rect.Right - Rect.Left - Canvas.TextWidth(Text)) div 2;
  end;
  // set colors
  Canvas.Font.Color := TextColor;
  Canvas.Brush.Color := BackColor;
  // paint the text
  ExtTextOut(Canvas.Handle, iLeftBorder, Rect.Top + BORDER_WIDTH, ETO_CLIPPED or ETO_OPAQUE,
             @Rect, PChar(Text), Length(Text), nil);
end;

////////////////////////////////////////////////////////////////
// the OnDrawCell event of the grid
procedure TForm1.grdColoredStringGridDrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  grdColored: TStringGrid;
  sText: String;
  myBackColor: TColor;
  myTextColor: TColor;
  myAlignment: TAlignment;
begin
  grdColored := TStringGrid(Sender);
  // set default values for the parameters,
  // get the values depending on the grid settings.
  sText := grdColored.Cells[ACol, ARow];
  if (ARow < grdColored.FixedRows) or (ACol < grdColored.FixedCols) then
    myBackColor := grdColored.FixedColor
  else
    myBackColor := grdColored.Color;
  myTextColor := grdColored.Font.Color;
  myAlignment := taLeftJustify;
  // set your own values...
  myTextColor := clGreen;
  // draw the text in the cell
  Sto_DrawCellText(grdColored.Canvas, Rect, sText, myBackColor, myTextColor, myAlignment);
end;

Hiding tabs in a PageControl

To write a wizard, it would be nice to use a PageControl with invisible Tabs. You can hide the tabs with the TabVisible property of TTabSheet and select the TabSheets in code.

////////////////////////////////////////////////////////////////
// hides all tabs (not the tabsheet itself) in the pagecontrol,
// and selects the first tabsheet as the active displayed.
procedure Sto_HideTabsInPageCtrl(PageControl: TPageControl);
var iPage: Integer;
begin
  // hide the tabs
  for iPage := 0 to PageControl.PageCount - 1 do
    PageControl.Pages[iPage].TabVisible := False;
  // set the active tabsheet
  if (PageControl.PageCount > 0) then
    PageControl.ActivePage := PageControl.Pages[0];
  // hide the border of the pagecontrol
  PageControl.Style := tsButtons;
end;

Using HTML help files (.chm)

Delphi offers a comfortable way to show context sensitive helpfiles, however the support is limited to the Windows help system (.hlp). If you want to work with HTML help files (.chm), then you have to write some extra code. Here you can download a unit, which will allow you to use HTML help files. You can use the normal Delphi VCL framework and write your projects the same way, as you would using normal (.hlp) files.

Download StoHtmlHelp (Delphi v6 v7) StoHtmlHelp.zip

To install the unit, simply add the unit to your project.

Since Delphi 2005, HTML help files are natively supported. You shouldn't use StoHtmlHelp then, instead add the "HTMLHelpViewer" unit to your project.

Creating special menu shortcuts

Adding shortcuts like <ctrl><c> to a menu item is very easy, since you can chose a lot of combinations in Delphi's property editor. What if you need another shortcut, not offered by the property editor? Special shortcuts like <ESC> or <alt><KeyDown> you can add at runtime in all possible combinations.

procedure TForm1.FormCreate(Sender: TObject);
begin
  // shortcut definition, not offered by the property editor
  mnuExit.ShortCut := ShortCut(VK_ESCAPE, []);
  mnuFindNext.ShortCut := ShortCut(VK_DOWN, [ssAlt]);
end;

Shortcuts of the form <alt><?> are normally generated with the caption property of the menu item. Insert a "&" character to generate an <alt> shortcut with the next letter, "Hello &world" would generate the shortcut <alt><w>.

Autosizing dropdown of a combobox

If the dropdown content exceeds the width of a combobox, then the text is hidden from the user. With the following small procedure you can fit the dropdown width automatically to the necessary size.

uses Windows, Messages, StdCtrls;

////////////////////////////////////////////////////////////////
// this procedure sets the with of the dropdown box, if the
// content is to large for the standard width.
procedure Sto_AutoWidthCombobox(Combobox: TCombobox);
const
  HORIZONTAL_PADDING = 4;
var
  iWidth: Integer;
  iIndex: Integer;
  iLineWidth: Integer;
begin
  iWidth := 0;
  // calculate the width of the drop down content
  for iIndex := 0 to Combobox.Items.Count - 1 do
  begin
    iLineWidth := Combobox.Canvas.TextWidth(Combobox.Items[iIndex]);
    Inc(iLineWidth, 2 * HORIZONTAL_PADDING);
    if (iLineWidth > iWidth) then
      iWidth := iLineWidth;
  end;
  // set the calculated width if necessary
  if (iWidth > Combobox.Width) then
    SendMessage(Combobox.Handle, CB_SETDROPPEDWIDTH, iWidth, 0);
end;

Delphi IDE

IDE keyboard shortcuts

In the standard configuration of the Delphi IDE, a lot of useful keyboard shortcuts are available, some of them are not very known. It's even possible to record and play simple keyboard macros.

Shortcut Description
<ctrl><shift><0..9>
<ctrl><0..9>
Set or remove the bookmark 0..9 .
Jump to the bookmark 0..9 in the currently opened file.
<ctrl><shift><i>
<ctrl><shift><u>
Indent the selected rows.
Unindent the selected rows.
<ctrl><shift><up>
<ctrl><shift><down>
Switch between declaration and implementation.
<alt><up>
<ctrl><left_mouse_button>
Find the implementation of a procedure or function.
<ctrl><e> Incremental search mode.
<ctrl><shift><r>
<ctrl><shift><p>
Start and stop the recording of a simple keyboard macro (record).
Replays the macro (play).
<ctrl><shift><g> Create a new GUID.

Output directories

In the project options you can set an output path for the executable and one for the compiled units (*.dcu). It's very useful to have the dcu's in a separate directory, but every programmer has to have this directory, otherwise he can't compile the project.

Since Delphi6 (?) it's possible to have global variables and relative paths in the output directories. Because all programmers will have at least a global temp path, you can set this variable as the dcu output directory. If you set a relative path as the executable directory, it's easier to move or copy the project.

Path Setting
..\bin Output path for the executable in a relative directory
$(TEMP) Output path for units (*.dcu)

Variants and COM

Empty and Null

Variants can handle several datatypes and some special states as EMPTY and NULL. Before you assign a value to a variant, it has the state EMPTY. There are a lot of functions to check the state or type of a variant and there are predefined variants you can use.

uses Variants;

procedure VariantDemo;
var
  vDemo: Variant;
  bTest: Boolean;
begin
  // EMPTY
  vDemo := Unassigned;          // assign EMPTY to variant
  bTest := VarIsEmpty(vDemo);   // check if variant is EMPTY
  // NULL
  vDemo := NULL;                // assign NULL to variant
  bTest := VarIsNull(vDemo);    // check if variant is NULL
  // numeric
  vDemo := 8.8;                 // assign a float to variant
  bTest := VarIsNumeric(vDemo); // check if variant is numeric
  // text
  vDemo := 'demo';              // assign a string to variant
  bTest := VarIsStr(vDemo);     // check if variant contains text
  // COM methods can define obtional parameters. if you are
  // working with typelibraries you have to pass a parameter
  // nevertheless, then you can pass "EmptyParam"
  vDemo := EmptyParam;
  bTest := VarIsEmptyParam(vDemo);
end;

How to register a COM server

Before you can use and test your new created COM server, you have to register it. You can do this with the Delphi menu Start\Register ActiveX-Server or you can register it by yourself. It depends on the kind of server you have (in-process *.dll or out-of-process *.exe) how to register the server.

  Register Unregister
in-process (MyServer.dll) regsvr32 MyServer.dll regsvr32 /u MyServer.dll
out-of-process (MyServer.exe) MyServer.exe /regserver MyServer.exe /unregserver

If you often have to do with COM servers, it is very useful to be able to (un)register them in the explorer. It's not difficult to extend the explorer's context menu, you can use this small reg file to add a "Register" and an "UnRegister" entry.

Download regfile StoComRegister.zip

Default property in a COM object

In COM you can define a default property, this is useful especially for lists. Assuming you have an implementation of a list with an "Items" property, the code could look like this:

// normal reading of an item
aItem := aList.Items[iIndex];
// with a default property defined
aItem := aList[iIndex];

Defining a default property is very easy, provided that you know where to look. In the typelibrary editor you go to the page "Attributes" and set the "ID" field to 0, done.

Modal forms in COM

When you are using modal forms in a COM server, you will miss the support of the menu shortcuts and the automatic navigation between the controls with the TAB key. this is because the "Application" object doesn't handle the windows messages, it is the window of the client application.

////////////////////////////////////////////////////////////////
// if you display a form from inside a COM server, you will miss the
// automatic navigation between the controls with the "TAB" key.
// the "KeyPreview" property of the form has to be set to "True".
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
var
  bShift: Boolean;
begin
  // check for tab key and switch focus to next or previous control.
  // handle this in the KeyPress event, to avoid a messagebeep.
  if (Ord(Key) = VK_TAB) then
  begin
    bShift := Hi(GetKeyState(VK_SHIFT)) <> 0;
    SelectNext(ActiveControl, not(bShift), True);
    Key := #0; // mark as handled
  end;
end;

////////////////////////////////////////////////////////////////
// if you display a form from inside a COM server, you will miss the
// support of the menu- and action- shortcuts like "<Ctrl><S>".
// the "KeyPreview" property of the form has to be set to "True".
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
const
  AltMask = $20000000;
var
  myMessage: TWMKey;
begin
  // recreate the original "KeyUp" message
  FillChar(myMessage, SizeOf(TWMKey), 0);
  myMessage.Msg := WM_KEYUP;
  myMessage.CharCode := Key;
  if (ssAlt in Shift) then
    myMessage.KeyData := AltMask;
  // find and execute matching shortcut
  if IsShortCut(myMessage) then
    Key := 0; // mark as handled
end;

Using interfaces without COM

Normally you will use interfaces in combination with COM objects. In contrast to conventional objects, a COM object supports reference counting and will free itself when the last reference is released.

You can use interfaces for your conventional objects too, without supporting reference counting and automatically freeing. Doing this, you have to pay attention to some special facts.

ITest = interface(IInterface)
  // press <ctrl><shift><g> to create your own GUID for each interface.
  // this is necessary to implement the "QueryInterface" method.
  ['{CA51B752-0DF5-40D2-945C-A5CF2EAA3B31}']
  procedure ShowText;
end;

TTest = class(TObject, ITest)
protected
  FText: String;
  // IInterface
  function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  function _AddRef: Integer; stdcall;
  function _Release: Integer; stdcall;
  // ITest
  procedure ShowText;
end;

Because every interface inherites from the parent interface "IInterface" (same as windows specific "IUnknown"), you have to support at least the three methods of "IInterface". This example shows a standard implementation.

function TTest._AddRef: Integer;
begin
  Result := -1; // no reference counting supported
end;

function TTest._Release: Integer;
begin
  Result := -1; // no reference counting supported
end;

function TTest.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := S_OK
  else
    Result := E_NOINTERFACE;
end;

procedure TTest.ShowText;
begin
  ShowMessage(FText);
end;

When you later use the object, you have to be careful, that at the moment of destruction, no reference to the interface remains.

procedure WellUsed;
var
  myTestObject: TTest;
  pTestInterface: ITest;
begin
  // creating the object
  myTestObject := TTest.Create;
  // get a reference to the interface of the object, this will implicitly call "_AddRef"
  pTestInterface := myTestObject;
  // ...
  // release the reference to the interface, this will implicitly call "_Release"
  pTestInterface := nil;
  // freeing the object itself
  myTestObject.Free;
end;

If you free the object, before the last reference to the interface is released, then the implicit call to "_Release" will call to a not existing object (Delphi will release the interface automatically, if you don't do it yourself).

procedure WrongUsed;
var
  myTestObject: TTest;
  pTestInterface: ITest;
begin
  myTestObject := TTest.Create;
  pTestInterface := myTestObject;
  // ...
  // freeing the object with an existing reference
  myTestObject.Free;
  // this releasing of the interface will implicitly call "_Release", but there
  // is no living object anymore.
  pTestInterface := nil;
end;

Normally, calling a method of a not existing object will cause a runtime error, not in our example. That's because no member of the object is used inside "_Release", as soon as you access a member, you will get the expected error. So, first make sure you don't call a "_Release" on a not existing object, then don't access members inside of "_Release".

function TTest._Release: Integer;
begin
  // this will cause an error, if the reference is released after the object was freed.
  FText := '';
  Result := -1; // no reference counting supported
end;

Valid XHTML 1.1 www.martinstoeckli.ch