Using my buildtools

 Delphi, dzLib  Comments Off on Using my buildtools
Sep 262015
 

My buildtools for Delphi have been available on SourceForge for quite a while. I use them in all my projects, including – slightly modified – in GExperts. Just in case somebody else is interested, I’ll outline how to use them in a project.

Requirements

First, your project has to follow the following structure:

Project
  src
    Project.dpr
    Project.dproj  

Notice that the main project directory should have the same name as your project, so if the project is called MyProject, the directory should have the same name (Exceptions are possible, see below). Also, the project files should be in a subdirectory called src (this cannot easily be changed).

Preparations

If these requirements are met, you can just add the build tools as an svn:external to a subversion project like this:

buildtools https://svn.code.sf.net/p/dzlib/code/buildtools/trunk

This will create a subdirectory buildtools to the project’s main directory.

Optional:
If your main project directory name is different from your project name, create a __SetProjectName.cmd script that sets the environment variable PROJECT to your project name:

set PROJECT=MyProject

All scripts will try to call this in order to get the project name. If it does not exist, the project name will be assumed to be the same as the main project directory.

The first step should now be to execute the script __CopyTemplates.cmd located in buildtools\templates. It will do the following:

  • Copy _BuildProject.cmd, _OpenInIde.cmd and _AutoBuildCheck.cmd to the project directory
  • Copy template.manifest.in to src\%project%.manifest.in
  • Copy template_icon.rc to src\%project%_icon.rc if it does not exist
  • Copy template_version.ini to src\%project%_version.ini if it does not exist.
  • open src\%project%_version.ini in notepad to be adjusted for the given project

src\%project%_version.ini is an ini file that maintains the version info of the project. The Delphi IDE (since Delphi 2005 and up until recently) notoriously mishandled the version information, so at some point I grew tired of it and moved the handling of version information to an external tool. More on that later. The format of the INI file should be familiar to all who have used Delphi 7 or earlier. The Version info in the .dof file there was in the same format.

The build tools assume that the project uses Delphi 2007 since that is the version with which I (have to) do most of my development work. If your project uses a different version, create a __DelphiVersion.cmd file with the following content:

set DelphiVer=XE2 

Replace the XE2 with your Delphi version:
6, 7, 2005, 2006, 2007, 2009, 2010, XE, XE2 … XE8 (I have yet to add Delphi 10 Seattle)

Now you should be able to open the project in the Delphi IDE by executing the _OpenInIDE.cmd script, do a commandline build by executing the _BuildProject.cmd script.

That’s the general preparation, now for the actual advantages of using these tools:

Version Information, Icon and Manifest
Up to Delphi 7 you could enter the version information into the projects settings dialog, check the “auto inc build number” option and let the IDE do everything else. The information was stored in the project.dof file. There was the disadvantage that the project.res file changed with every build but most people didn’t mind that much. If you deleted the .res file, it would be recreated with the correct version info, all you lost was the icon. Unfortunately a command line build using dcc32 did not increment the build number. Then Borland jumped on the dotNET wagon and created a new IDE. This new IDE botched the handling of the version info vs. the project.res file completely. Now, the master version information was stored in the project.res file and the IDE updated the project.bdsproj file (and later the project.dproj file) from there. The command line compiler still did not increment the build number.

At that point I got fed up and wrote dzPrepBuild. It is a small tool that can read and modify .dof, .bdsproj, .dproj and .ini files. But the most important function is creating a .rc file with the version information that can be compiled to a .res file which in turn can be used by Delphi to add version information to the executable. It also creates a manifest file for Windows Vista and later, containing the version information.

So, in order to use it, do the following:

  • Disable version information in your project
  • Add the following Pre-Build event (Delphi 2007 and up):
    call ..\buildtools\prebuild.cmd $(PROJECTPATH)
    
  • Add the following Post-Build event (Delphi 2007 and up):
    call ..\buildtools\postbuild.cmd $(OUTPUTDIR)$(OUTPUTNAME)
    
  • In the project.dpr file remove the {$ *.res} line
  • and add the following lines
      {$R *_version.res}
      {$R *_icon.res}
      {$R *_manifest.res}
    

If you use a Delphi version older than Delphi 2007, you must find another way to call the prebuild and postbuild scripts, because Pre- and Post-Build events were only introduce with Delphi 2007.

So, what does prebuild.cmd do?

  • It increments the build number in src\%project%_version.ini
  • Writes a src\%project%_version.rc from this information
  • If src\%project%.manifest.in exists, writes a src\%project%.manifest and a corresponding src\%project%_manifest.rc
  • Calls brcc32 to compile src\%project%_version.rc to a .res file
  • If src\%project%_manifest.rc exists, calls brcc32 to compile it to a .res file
  • If src\%project%_icon.rc exists, calls brcc32 to compile it to a .res file

Oh, I haven’t mentioned the %project%_icon.rc file yet: It’s a text file that only contains one line:

MAINICON ICON LOADONCALL MOVEABLE DISCARDABLE IMPURE "../buildtools/dz.ico"

You should adapt it to point to the .ico file you want to use for your project. Alternatively you can delete the .rc file if you don’t want to have an icon. In this case you also must remove the {$R *_icon.res} line from the project.dpr file. Here is a hint on creating icons from multiple png files.

Regarding the manifest: Newer versions of Windows (starting with Vista) have the (I think) annoying habit of virtualizing access to the registry and some file system folders to which a program does not have write access. If you don’t tell Windows to not do that, you will not even notice your programming errors. To tell Windows to go and play somewhere else, you need a manifest. A manifest is an xml file that is added to the executable as a resource. That’s what the project_manifest.rc file does. Windows looks into that xml file in order to find out whether the program is compatible to a particular Windows version. The template.manifest.in file in buildtools\templates contains the following text:

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<!--
  This manifest tells Windows Vista (and Windows 7/8) not to virtualize any file
  or registry access. Also, it disables themes support.
 -->
  <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
  <assemblyIdentity version="1.0.0.0"
    processorArchitecture="*"
    name="template from dzlib build tools"
    type="win32"/>
<!-- We do not want themes support
  <dependency>
    <dependentassembly>
    <assemblyidentity type="win32"
      name="Microsoft.Windows.Common-Controls"
      version="6.0.0.0"
      publickeytoken="6595b64144ccf1df"
      language="*" processorarchitecture="*">
      </assemblyidentity>
      </dependentassembly>
  <dependency>
 -->
  <description>This application was built using buildtools from dzlib</description>
  <!-- COMPATIBILITY SECTION SPECIFIES IF APP IS COMPLIANT 
       DISABLES PCA IF SPECIFIED -->
  <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
    <application>
      <!-- We support Windows Vista -->
      <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
      <!-- We support Windows 7 -->
      <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>
      <!-- We support Windows 8 -->
      <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/>
      <!-- We support Windows 8.1 -->
      <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/>
      <!-- We support Windows 10 -->
      <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/>
    </application>
  </compatibility>
    
  <!-- TRUSTINFO SECTION SPECIFIES REQUESTED PERMISSIONS AND 
       UIPI DISABLEMENT (SPECIAL CONDITIONS APPLY TO UIPI DISABLEMENT)-->
  <trustInfo xmlns="urn:schemas-microsoft-com:asm.v2">
    <security>
      <requestedPrivileges>
        <requestedExecutionLevel
          level="asInvoker"
          uiAccess="false"/>
        </requestedPrivileges>
       </security>
  </trustInfo>
</assembly>

Apart from claiming compatibility to Windows Vista, 7, 8, 8.1 and 10 this manifest also disables theming (you might want to change that) and tells Windows to not run with any elevated privileges. MSDN has some more information on manifests.

Please note that the manifest also contains the version information. The prepbuild tool will read src\%project%.manifest.in and create src\%project%.manifest, overwriting the latter if it exists. So in order to change the manifest, you should edit src\%project%.manifest.in.

JclDebug Information and Translation

The postbuild.cmd file’s job is to do the following:

  • Append JclDebug information to the executable by calling the AppendJclDebug.cmd script, which in turn calls the makejcldbg executable
  • Append translations for dxGetText to the executable by calling AppendTranslations.cmd which in turn calls the dxgettext tools.

I have written a separate blog post on Using JclDebug in your program. See there for an introduction on how it works. For the above to work, you should enable a full map file in the project’s Linker options.

AppendTranslation.cmd assumes that you use GNU Gettext for Delphi and C++ Builder (dxgettext) for translating your projects. It expects translations for German, English and French in subdirectories of translations:

project
  buildtools
  src
  translations
    de
    en
    fr

The translation files themselves are called default.po and can be created with either the explorer extensions that come with dxgettext or by copying the _ExtractTranslations.cmd script from builtools to the main project directory and executing it there.

The .po files are compiled to binary .mo files which are created in the corresponding directory under locale:

project
  locale
    de
      LC_MESSAGES
    en
      LC_MESSAGES
    fr
      LC_MESSAGES

You must create these directories for the AppendTranslation.cmd script to work. (Edit: A new script in buildtools PrepareForTranslation.cmd can do that for you. — 2015-10-4 twm)

That’s it for now. I hope this short overview isn’t too confusing for somebody who hasn’t used the buildtools before. If you like them, feel free to use them. If you have suggestions, please contact me through my Google+ profile.

 Posted by on 2015-09-26 at 14:15

Using the %TEMP% directory

 Delphi, dzLib  Comments Off on Using the %TEMP% directory
Aug 162015
 

Sometimes you need to temporarily create a file or even a directory to put some files into. Windows (and most other operating systems, even MS DOS) reserves a special directory for this purpose and helpfully provides API methods for getting this directory (or you could just use the %TEMP% environment variable but while that is convenient for batch files, it is less convenient in a program).

So, there is the GetTempPath Windows API function. For Delphi programmers it is a bit cumbersome to use because like all API functions it works with zero terminated strings (PChar). My dzlib contains a utility function that wraps this call and returns a string:

class function TFileSystem.GetTempPath: string;
var
  Res: Integer;
  LastError: Integer;
begin
  // according to MSDN the maximum length of the TEMP path is MAX_PATH+1 (261)
  // an AnsiString / WideString always has one additional character to the length for storing
  // the terminating 0
  SetLength(Result, MAX_PATH);
  Res := Windows.GetTempPath(MAX_PATH + 1, PChar(Result));
  if Res <= 0 then begin
    // GetLastError must be called before _(), otherwise the error code gets lost
    LastError := GetLastError;
    RaiseLastOSErrorEx(LastError, _('TFileSystem.GetTempPath: %1:s (code: %0:d) calling Windows.GetTempPath'));
  end;
  SetLength(Result, Res);
end;

While it is nice to know where to put the files, sometimes you want not just a directory to put the file into but also a unique filename. Again, the Windows API can help here with the GetTempFileName function. And since it too requires you to use PChar I have wrapped it again:

class function TFileSystem.GetTempFileName(_Directory: string = ''; const _Prefix: string = 'dz'; _Unique: Word = 0): string;
var
  Res: Integer;
  LastError: Cardinal;
begin
  if _Directory = '' then
    _Directory := GetTempPath;
  SetLength(Result, MAX_PATH);
  Res := Windows.GetTempFileName(PChar(_Directory), PChar(_Prefix), _Unique, PChar(Result));
  if Res = 0 then begin
    // GetLastError must be called before _(), otherwise the error code gets lost
    LastError := GetLastError;
    RaiseLastOSErrorEx(LastError, _('TFileSystem.GetTempFilename: %1:s (Code: %0:d) calling Windows.GetTempFileName'));
  end;
  Result := PChar(Result); // remove trailing characters
end;

Sometimes you want to not only create a single file but many of them and rather than cluttering the TEMP directory with your files, you might want to create a subdirectory for this purpose. There is no Windows API for this (at least I don’t know any), so I have written my own function for it:

class function TFileSystem.CreateUniqueDirectory(_BaseDir: string = ''; const _Prefix: string = 'dz'): string;
var
  Pid: DWORD;
  Counter: Integer;
  Ok: Boolean;
  s: string;
begin
  if _BaseDir = '' then
    _BaseDir := GetTempPath;
  Pid := GetCurrentProcessId;
  s := itpd(_BaseDir) + _Prefix + '_' + IntToStr(Pid) + '_';
  Counter := 0;
  Ok := False;
  while not Ok do begin
    Result := s + IntToStr(Counter);
    Ok := Self.CreateDir(Result, ehReturnFalse);
    if not Ok then begin
      Inc(Counter);
      if Counter > 1000 then
        raise ECreateUniqueDir.CreateFmt(_('Could not find a unique directory name based on "%s"'), [Result]);
    end;
  end;
end;

This function uses the provided prefix (or the default ‘dz’), current process ID and a number (starting at 0) to create a unique directory. If creating the directory fails, the number is incremented and tried again.

Using it is pretty simple:

MyTempoaryWorkingDir := TFileSystem.CreateUniqueDirectory;

This will create the unique directory

%TEMP%\dz_815_0

Or, if you don’t want to use the TEMP directory, specify your own:

MyTempoaryWorkingDir := TFileSystem.CreateUniqueDirectory('c:\rootofallmyworkingdirs');

This will create the unique directory

c:\rootofallmyworkingdirs\dz_815_0

And if you don’t like the ‘dz’ prefix, just specify your own:

MyTempoaryWorkingDir := TFileSystem.CreateUniqueDirectory('', 'bla');

This will create the unique directory

%TEMP%\bla_815_0

Usually you want to clean up any temporary files when your program exits. In the case of a unique temporary working directory, this simply means that you delete the whole directory. Since I am lazy bastard ™ I have of course wrapped that into a helper function:

type
  IUniqueTempDir = interface ['{D9A4A428-66AE-4BBC-B1CA-22CE4DE2FACB}']
    function Path: string;
    ///<summary> Path including trailing path delimiter </summary>
    function PathBS: string;
  end;
  // [...]

type
  TUniqueTempDir = class(TInterfacedObject, IUniqueTempDir)
  private
    FPath: string;
    FDeleteOnlyIfEmpty: Boolean;
    function Path: string;
    ///<summary> Path including trailing path delimiter </summary>
    function PathBS: string;
  public
    constructor Create(const _Path: string; _DeleteOnlyIfEmpty: Boolean = False);
    destructor Destroy; override;
  end;

{ TUniqueTempDir }

constructor TUniqueTempDir.Create(const _Path: string; _DeleteOnlyIfEmpty: Boolean = False);
begin
  inherited Create;
  FPath := _Path;
  FDeleteOnlyIfEmpty := _DeleteOnlyIfEmpty;
end;

destructor TUniqueTempDir.Destroy;
begin
  // delete directory, fail silently on errors
  if FDeleteOnlyIfEmpty then
    TFileSystem.RemoveDir(FPath, False)
  else
    TFileSystem.DelDirTree(FPath, False);
  inherited;
end;

function TUniqueTempDir.Path: string;
begin
  Result := FPath;
end;

function TUniqueTempDir.PathBS: string;
begin
  Result := itpd(FPath);
end;

class function TFileSystem.CreateUniqueTempDir(_DeleteOnlyIfEmpty: Boolean = False; _Prefix: string = 'dz'): IUniqueTempDir;
var
  s: string;
begin
  s := CreateUniqueDirectory(GetTempPath, _Prefix);
  Result := TUniqueTempDir.Create(s, _DeleteOnlyIfEmpty);
end;

The function TFileSystem.CreateUniqueTempDir returns an interface which means it is reference counted. Once the interface goes out of scope, the object is freed and the destructor deletes the whole directory tree. Of course you must make sure that you keep a reference to the interface around as long as you need the files.

procedure DoSomethingTemporary;
var
  TempDir: IUniqueTempDir;
  st: TFileStream;
begin
  TempDir := TFileSystem.CreateUniqueTempDir;

  CreateAFileIn(TempDir.Path, st);
  WorkWithTheFile(st);
  DontForgetToCloseIt(st);
end; // the interface goes out of scope here

There is an overloaded function which allows to specify a different base directory as well:

    class function CreateUniqueTempDir(const _BaseDir: string; _DeleteOnlyIfEmpty: Boolean = False; _Prefix: string = 'dz'): IUniqueTempDir;

All those helper functions are in the unit u_dzFileUtils, in case you want to look it up.

 Posted by on 2015-08-16 at 13:16

Input validation in dzLib

 Delphi, dzLib  Comments Off on Input validation in dzLib
Apr 152015
 

In a recent Google+ post Andrea Raimondi was mentioning the JVCL’s JvValidators components and asked whether we use/know them or not. Daniela Osterhagen mentioned that she preferred the input validation from my dzlib which led to a short discussion about how I implemented it.

I added input validation functionality to dzlib because I didn’t like the way JvValidators works. I’ll not go into the reasons but the most important one was performance, the programs using JvValidators felt like running on an old 286 computer. Instead I’m going to show here, how it currently works. Note that I am not satisfied with this yet, see below for the reasons.

First thing you do, is get an instance of the IdzInputValidator interface by calling the InputValidator function from unit u_dzInputValidator. That function takes two optional TColor parameters OKColor and ErrColor which default to clWindow and clYellow respectively.

procedure TMyForm.CheckInput;
var
  iv: IdzInputValidator;
begin
  iv := InputValidator; // we just take the default colours

This interface has a number of overloaded Check methods that take different types of controls, I have implemented Check methods for T(Custom)Edit, T(Custom)ComboBox, T(Custom)Checkbox and TJvDateEdit (but see below). These methods return specialized interfaces that are meant to validate the data in theses controls. I’ll show that using a TEdit for entering an integer number between 5 and 10 (including these limits) as an example.

   // continued from above
   iv.Check(ed_NumberInput).AsInteger.IsBetween(5, 10);

If it is allowed for the TEdit to be left empty, there is this alternative:

   // continued from above
   iv.Check(ed_OptionalNumberInput).AsInteger.IsBetweenOrEmpty(5, 10);

These are actually several function calls wrapped into one line:
Check, returns an IdzEditValidator interface, AsInteger returns a IdzEditIntegerValidator interface and IsBetween / IsBetweenOrEmtpy returns a boolean. I am using interfaces because I am a lazy bastard™. I don’t want the hassle of freeing the classes that are being created on the fly.

After you have validated the input of all these controls, you ask the IdzInputValidator interface for the result. There are two overloaded GetResult methods, one simply returns a boolean, the other also returns an error message. I am assuming here that there is a TStatusBar on the form which will display this error message and an OK button that should be enabled only if the input is valid.

  // continued from above
  b_Ok.Enabled := iv.GetResult(ErrMsg); // note: Declare ErrMsg: string
  TheStatusBar.SimpleText := ErrMsg;
end;

To make CheckInput do anything at all, you need to call it when the data in the form changes, e.g. in the OnChange events of the controls.

procedure TMyForm.ed_NumberInputChange(Sender: TObject);
begin
  CheckInput;
end;

Behind the scene IdzInputValidator and friends change the background colour of the input controls based on whether the input is valid or not. If it is valid, the colour is set to the OKColor, if not, it is set to the ErrColor. These colours were passed to the call to the InputValidator function right at the start and default to clWindow and clYellow. It’s a matter of (bad?) taste which colours you prefer. I like yellow because it still allows to read the input easily in contrast to e.g. red. Instead of colouring the controls it is also possible to show a blinking icon with an exclamation mark like JvValidators does but I am not going into that right now.

This implementation is already the second rewrite of the code. In the beginning IdzEditValidator used to have lots of methods like ValidateFloat, ValidateFloatBetween, ValidateInteger, ValidateIntegerBetween, ValidateDate etc. I changed it to have these As<someType> methods that return more specialized interfaces because it became unwieldy. I was pretty satisfied with this implementation until there was a requirement to validate additional controls.

The first one was TJvDateEdit. This required JvToolEdit to be added to the uses clause of u_dzInputValidator. Not every program uses the JVCL, so I added the conditional define NO_JVCL to exclude this code. Not pretty, but I could live with it.

The next one was TSigFilenameEdit (which is an internally developed control at work that is a bit similar to TJvFilenameEdit). It required an ugly hack because I could not simply add the unit that defines it to the uses clause of u_dzInputValidator.

It became worse when there was a requirement to not only validate the controls on a form but the validation was to span several frames which were put on this form.

Generally this problem is referred to as tight a coupling, in this case between the validator interface an the controls. There are a few ideas to resolve this issue:

1. I could create descendants of IdzInputValidator that know additional controls, so there would be additional Check methods that take a TSigFilenameEdit or even a Tfr_MyFrame parameter. This breaks down as soon as there are multiple, mutually exclusive controls to support. e.g. Support for JVCL controls and internal controls, because there is no multiple inheritance support in Delphi. (Hm, I’m not even sure whether mutliple inheritance could solve that problem. Maybe generics or rather my pseudo templates could? I’ll have to thing about this one.)

2. I could create overloaded functions ControlValidator that take a control and an IdzInputValidator interface like this:

function ControlValidator(_ed: TEdit; _iv: IdzInputValidator): IdzEditValidator; overload;
function ControlValidator(_ed: TJvDateEdit; _iv: IdzInputValidator): IdzJvDateEditValidator; overload;

These functions, in contrast to the methods of an interface, could be distributed over multiple units so I could include only those units that support the controls I am currently using. (This would be similar to the different IDatasetHelper implementations for BDE, ADO, ZEOS, tdbf etc. in dzlib.) This would sacrifice some convenience but would pretty much work. I don’t like the additional iv parameter, it just clutters the code. Also, the programmer would be responsible to add the unit containing the function declaration, e.g. for supporting TJvDateEdit add u_dzInputValidatorJVCL.

3. I could come up with some kind of registration mechanism for control validators that register validators for various kinds of controls with a central factory. That factory would then return the correct validator interface for a given control. That would add more complexity to the currently simple way of the validation mechanism. Also, how do I then call the actual validation methods? Have a generic interface that takes e.g. a string describing the check I want to do? No, too ugly.

4. I could revert to checking strings rather than control content. Maybe all that is required is a way to get the control’s content as a string, so TCheckbox.Checked would be converted to ‘Y’ and TCombobox.ItemIndex with IntToStr(…), so solution 3. could be simplified to supply an interface that returns a string which then gets checked. That could be even taken further to using regular expressions. (Remember that joke: You have a problem, you decide to solve it with regular expressions, now you have two problems.)

I am currently leaning towards solution 2. It allows the most flexibility without adding too much overhead. But I am going to publish this blog post on G+ to ask for feedback. Maybe somebody else has a brilliant idea?
Here is the G+ post.

 Posted by on 2015-04-15 at 16:33

Setting a default language with dxgettext

 Delphi, dzLib  Comments Off on Setting a default language with dxgettext
Nov 102014
 

By default, if no translation for a language is available, dxgettext will not do any translation but use the strings as they are in the source code. Sometimes this is not desirable. e.g.

  • Your customer does not understand the source language (e.g. your source language is not English but say German)
  • You are using dxgettext to convert special characters from a placeholder (e.g. “(R)” or “[deg]”) to the actual character (“®” or “°”)

In these cases you’d probably want the translation to default to a language that is actually supplied.

dxgettext doesn’t seem to have this feature (I looked quite hard) so I implemented it myself.

unit u_dzTranslator;

interface

// ... other stuff ...

///<summary>
/// Sets the language to use </summary>
procedure UseLanguage(_LanguageCode: string);

///<summary>
/// gets a list of languages for which translations are available </summary>
procedure GetListOfLanguages(const _Domain: string; _Codes: TStrings;
  _Languages: TStrings = nil);

///<summary>
/// Sets the language to use if the desired language is not available,
/// defaults to English </summary>
procedure SetDefaultLanguage(const _LanguageCode: string);

// ... other stuff ...

implementation

uses
  gnugettext;

// ... other stuff ...

const
  DEFAULT_LANGUAGE = 'en';
var
  gblDefaultLanguage: string = DEFAULT_LANGUAGE;

procedure UseLanguage(_LanguageCode: string);
var
  Codes: TStringList;
  CurLang: string;
  i: Integer;
  p: Integer;
begin
  gnugettext.UseLanguage(_LanguageCode);

  CurLang := gnugettext.GetCurrentLanguage;
  Codes := TStringList.Create;
  try
    GetListOfLanguages('default', Codes);
    for i := 0 to Codes.Count - 1 do begin
      if SameText(CurLang, Codes[i]) then begin
        // There is a translation for this language and country, everything is fine
        Exit; //-->
      end;
    end;
    // no translation found, try without the country code
    p := Pos('_', CurLang);
    if p <> 0 then begin
      CurLang := Copy(CurLang, 1, p - 1);
      for i := 0 to Codes.Count - 1 do begin
        if SameText(CurLang, Codes[i]) then begin
          // There is a translation for this language but not country, we can live with that
          Exit; //-->
        end;
      end;
    end;
  finally
    FreeAndNil(Codes);
  end;

  // we found no translation for this language, so we use the default language
  gnugettext.UseLanguage(gblDefaultLanguage);
end;

procedure SetDefaultLanguage(const _LanguageCode: string);
begin
  if _LanguageCode = '' then
    gblDefaultLanguage := DEFAULT_LANGUAGE
  else
    gblDefaultLanguage := _LanguageCode;
  UseLanguage(gnugettext.GetCurrentLanguage);
end;

procedure GetListOfLanguages(const _Domain: string; _Codes: TStrings; _Languages: TStrings = nil);
var
  i: Integer;
begin
  _Codes.Clear;
  gnugettext.DefaultInstance.GetListOfLanguages(_Domain, _Codes);
  if Assigned(_Languages) then begin
    _Languages.Clear;
    for i := 0 to _Codes.Count - 1 do begin
      _Languages.Add(languagecodes.getlanguagename(_Codes[i]));
    end;
  end;
end;

// ... other stuff ...

initialization
  SetDefaultLanguage(DEFAULT_LANGUAGE);
end.

Apart from the obvious, that is, setting a unit global variable to the desired default language, which itself defaults to English, this code changes the way UseLanguageWorks. It now does:

  • Call gnugettext.UseLanguage to let gnugettext do its stuff
  • Call gnugettext.GetCurrentLanguage to get the language that gnugettext uses (just in case gnugettext changes it from what was set with UseLanguage).
  • Gets a list of all supported translations
  • Tries to find a matching translation for the desired language and country.
  • If not found, tries to find a matching translation for the desired language, ignoring the country
  • If not found, changes the language to the default language.

Note that I just wrote this code, it might still contain bugs and is probably far from perfect. I will put it into the unit u_dzTranslator of my dzlib library and will fix any bugs I find in the future there.

 Posted by on 2014-11-10 at 13:16

dzlib compiles with all Delphi versions from 2007 to XE6

 Delphi, dzLib  Comments Off on dzlib compiles with all Delphi versions from 2007 to XE6
Sep 132014
 

Today I spent some time to make dzlib compile with all Delphi versions from 2007 to XE6 (XE7 to come later). It didn’t take too long since it already supported 2007, XE2 and XE6.

It’s interesting to see, how the RTL evolved between these versions. Some examples:

  • The IsWhitespace function started out as a class method of TCharacter, then moved to TCharHelper and finally ended up as a method of the Char type itself (probably added through a class helper, I didn’t check).
  • The global DecimalSeparator variable was marked deprecated for a long time (replaced by a property of the global FormatSettings class) and has finally been removed from the RTL.

There is also a breaking change in the Delphi XE6 RTL:
You can no longer create a TThread suspended and then call Resume/Start from within its constructor. If you do that, you will get an exception. But since the thread no longer gets started until the constructor has run that is no longer necessary.

 Posted by on 2014-09-13 at 20:51

Showing a dropdown menu when clicking a button

 Delphi, dzLib  Comments Off on Showing a dropdown menu when clicking a button
Aug 312014
 

A rather common question on StackOverflow, the Delphi newsgroups and elsewhere is how to display a drop down menu when the user presses a button.

ButtonWithDropdown

There are many proposed solutions and even something built into newer versions of Delphi (Which doesn’t work for me for some reason.)

Here is mine (which is based on this answer on StackOverflow):
First, I create a helper class based on TComponent. It links the button (which can be TButton or TBitBtn or anything else derived from TCustomButton) to the popup menu and hooks its OnClick event. To access the OnClick event, which is protected in TCustomButton, we need to cast it to TCustomButtonHack. The OnClick event then displays the popup menu. For convenience I set the helper class’s parent to the button, so it automatically gets freed when the button does get freed.

type
  TButtonPopupMenuLink = class(TComponent)
  private
    FBtn: TCustomButton;
    FMenu: TPopupMenu;
    FLastClose: DWORD;
  public
    constructor Create(_btn: TCustomButton; _pm: TPopupMenu);
    procedure doOnButtonClick(_Sender: TObject);
  end;

{ TButtonPopupMenuLink }

type
  TCustomButtonHack = class(TCustomButton)
  end;

constructor TButtonPopupMenuLink.Create(_btn: TCustomButton; _pm: TPopupMenu);
begin
  inherited Create(_btn);
  FBtn := _btn;
  FMenu := _pm;
  FMenu.PopupComponent := FBtn;
  FBtn.OnClick := Self.doOnButtonClick;
end;

procedure TButtonPopupMenuLink.doOnButtonClick(_Sender: TObject);
var
  Pt: TPoint;
begin
  if GetTickCount - FLastClose > 100 then begin
    Pt := FBtn.ClientToScreen(Point(0, FBtn.ClientHeight));
    FMenu.Popup(Pt.X, Pt.Y);
    { Note: PopupMenu.Popup does not return until the menu is closed }
    FLastClose := GetTickCount;
  end;
end;

And just for some more convenience I add a procedure that just creates that helper class, so I don’t have to expose the class through the unit’s interface but only that procedure:

procedure TButton_AddDropdownMenu(_btn: TCustomButton; _pm: TPopupMenu);
begin
  TButtonPopupMenuLink.Create(_btn, _pm);
end;

To use it I call that procedure from the form’s constructor:

constructor TMyForm.Create(_Owner: TComponent);
begin
  inherited Create;
  // other stuff
  TButton_AddDropdownMenu(b_MenuButton, pm_MenuButton);
end;

I have put that code into u_dzVclUtils, which is part of my dzlib library.

 Posted by on 2014-08-31 at 16:36

Translating Windows messages to strings

 Delphi, dzLib  Comments Off on Translating Windows messages to strings
Aug 242014
 

I could not find anything like this so I wrote it myself:

This class translates most Windows message ids into their symbolic name.

type
  TWmMessageToString = class
    function MsgToString(const _WmMsg: Cardinal): string; overload;
    function MsgToString(const _Msg: TMessage): string; overload;
  end;

The names are taken from

  • Delphi 2010’s messages.pas
  • Delphi 2010’s controls.pas
  • Wine

It seems pretty complete, but if a message cannot be found, the MsgToString methods return its hexadecimal and decimal representation.

The code is part of my dzlib its the u_dzWmMessageToString unit.

 Posted by on 2014-08-24 at 22:42

Preventing a dialog from closing while autocomplete is active

 Delphi, dzLib  Comments Off on Preventing a dialog from closing while autocomplete is active
Aug 242014
 

In an older blog post I wrote about AutoComplete for TEdits using SHAutoComplete.

I just actually tried to use that function in one of my applications and found that there is a quite annoying problem with it: If you have set the OK button’s Default property to true (so it gets “clicked” when you press return), selecting an entry from the autocomplete list with the return key also closes the form, which is usually not what the user wants.

I turns out that I am not the first to stumble upon that problem.

The suggestion posted there by mghie is a bit ugly because it hooks the Application.OnMessage event which might conflict with other code that uses it.

I had another problem anyway (see below) so I extended a class that hooks a TEdit’s WindowProc method instead. Here is the code:

procedure TAutoCompleteActivator.NewWindowProc(var _Msg: TMessage);
begin
  if (_Msg.Msg = CM_WANTSPECIALKEY) then begin
    if (_Msg.wParam = VK_RETURN) or (_Msg.wParam = VK_ESCAPE) then begin
      if IsAutoSuggestDropdownVisible then begin
        _Msg.Result := 1;
        Exit; //==>
      end;
    end;
  end;
  inherited NewWindowProc(_Msg);
end;

The IsAutoSuggestDropdownVisible function is directly taken from mghie’s answer:

function EnumThreadWindowsProc(AWnd: HWnd; AParam: LParam): BOOL; stdcall;
var
  WndClassName: string;
  FoundAndVisiblePtr: PInteger;
begin
  SetLength(WndClassName, 1024);
  GetClassName(AWnd, PChar(WndClassName), Length(WndClassName));
  WndClassName := PChar(WndClassName);
  if WndClassName = 'Auto-Suggest Dropdown' then begin // do not translate
    FoundAndVisiblePtr := PInteger(AParam);
    FoundAndVisiblePtr^ := Ord(IsWindowVisible(AWnd));
    Result := False;
  end else
    Result := True;
end;

function IsAutoSuggestDropdownVisible: Boolean;
var
  FoundAndVisible: Integer;
begin
  FoundAndVisible := 0;
  EnumThreadWindows(GetCurrentThreadId, @EnumThreadWindowsProc,
    LParam(@FoundAndVisible));
  Result := FoundAndVisible > 0;
end;

This works fine in my program compiled with Delphi 2010 and running on Windows 8.1 (your mileage may vary).

Edit: It also works fine compiled with Delphi 2007 and running onWindows 7.

Now to the other problem mentioned above:
In the old blog post I published a TEdit_SetAutocomplete function that activates autocomplete for a TEdit control. This function works fine as as long as you don’t try to call it in the form’s constructor. If you do, it does nothing. The reason is that the TEdit’s handle gets destroyed and recreated after the form’s constructor was called, which results in autocomplete being turned off again. One option would have been to put the function call into the form’s OnShow handler, but I am no fan of distributing code that in my opinion belongs into the constructor to these event handlers, so I wanted a different solution.

It turned out that I already had one in my dzlib.u_dzVclUtils unit: TWinControl_ActivateDropFiles returns a TObject that hooks the TWinControl’s WindowProc and handles the WM_NCCREATE and WM_NCDESTROY messages. I refactored that class a bit to create a generic TWindowProcHook ancestor and derived TAutoCompleteActivator from it. Its WmNcCreate method now looks like this:

procedure TAutoCompleteActivator.WmNcCreate;
begin
  inherited;
  SetAutoComplete;
end;

procedure TAutoCompleteActivator.SetAutoComplete;
begin
  TEdit_SetAutocomplete(FCtrl as TCustomEdit, FSource, FType);
end;

So every time the window handle gets created anew, it activates autocomplete for it again.

The full code can be found in my dzlib library on OSDN. It’s in the u_dzVclUtils unit (the preview only shows the first 3000 lines of the unit).

 Posted by on 2014-08-24 at 22:20

Adding fields to a TDataset in code

 Delphi, dzLib  Comments Off on Adding fields to a TDataset in code
Jul 122014
 

The Delphi IDE allows you to add fields to a TDataset (descendant e.g. TTable, TQuery, TAdoTable etc.) by right clicking on the component and selecting “Add Field” or “New Field”. For a particular project I didn’t want to do that because I kept changing the query for which I want to add the fields. But since there was one calculated field I had to add fields to the dataset otherwise the OnCalcFields event wouldn’t be called. So I ended up adding the fields in code.

Basically that’s easy, you just create a TField descendant (e.g. TStringField,TAutoIncField, TDateTimeField etc.) set the field name and dataset and that’s it. But there are some pitfalls:

var
  fld: TField;
  ds: TDataset;
begin
  // init Dataset
  // ...
  // add fields
  fld := TWideStringField.Create(ds);
  fld.Name := '';
  fld.FieldName := 'TE_Employee';
  ds.Fields.Add(fld);

While this looks fine, it will not work. You will get the error “Field does not have a dataset” (or similar, I don’t remember the exact error message). The reason is that adding the field to the Dataset’s Fields collection does not automatically tell the field to which dataset it belongs. For that you need to assign the field’s Dataset property.

var
  fld: TField;
  ds: TDataset;
begin
  // init Dataset
  // ...
  // add fields
  fld := TWideStringField.Create(ds);
  fld.Name := '';
  fld.FieldName := 'TE_Employee';
  fld.Dataset := ds;
  ds.Fields.Add(fld);

If you write it like this, it will seem to work, but you will get an access violation when the dataset is being destroyed. Can you spot why?

I had to trace into the RTL sources to find the problem: The field was added to the Fields collection twice, because setting its Dataset property also adds it to the Fields collection. So, when the field’s collection got freed, the Field was freed twice, resulting in the AV.

So the correct and working code is this:

var
  fld: TField;
  ds: TDataset;
begin
  // init Dataset
  // ...
  // add fields
  fld := TWideStringField.Create(ds);
  fld.Name := '';
  fld.FieldName := 'TE_Employee';
  fld.Dataset := ds; // this automatically adds the field to the Dataset's Fields collection.

You might be wondering about the line

  fld.Name := '';

I set the name of all components created in code to an empty string to avoid name collisions with any existing components or even a different instance of the component created by the same code. “A component with the name Edit1 already exists.” has bitten me too often.

Since I also used a TDbGrid to display the dataset, I also added Columns to the DBGrid to set the caption and column width. And since I am lazy (as any good programmer should be), I moved most of that code into a (sub-) procedure to make the code more readable (actually I did it so I had less to type, but the result is the same):

var
  TheDataset: TDataset;
  TheGrid: TDbGrid;

procedure TMyForm.InitDbGrid;

  procedure AddField(_fld: TField; const _Fieldname: string; const _Caption: string; _Width: Integer);
  var
    Col: TColumn;
  begin
    _fld.FieldName := _Fieldname;
    _fld.ReadOnly := True;
    _fld.Dataset := TheDataset;
    Col := TheGrid.Columns.Add;
    Col.Expanded := False;
    Col.FieldName := _Fieldname;
    Col.Title.Caption := _Caption;
    Col.Width := _Width;
  end;

begin
  AddField(TAutoIncField.Create(nil), 'SeNr', _('Number'), 50);
  AddField(TDateTimeField.Create(nil), 'TeArbeitstag', _('Date'), 70);
  AddField(TWideStringField.Create(nil), 'SeVon', _('Start'), 40);
  AddField(TWideStringField.Create(nil), 'SeBis', _('End'), 40);
  fld := TWideStringField.Create(nil);
  fld.FieldKind := fkCalculated;
  AddField(fld, 'Stunden', _('Hours'), 50);
  AddField(TWideStringField.Create(nil), 'PROJ_IDENT', _('Project'), 50);
  AddField(TWideStringField.Create(nil), 'SSchluessel', _('Activity'), 50);
  AddField(TWideStringField.Create(nil), 'SeBeschreibung', _('Description'), 200);
  ResizeGridColumns;
end;

And just to show why this code is actually useful, here are the ResizeGridColumns method and TheDatasetCalcFields and FormResize events.

procedure TMyForm.ResizeGridColumns;
var
  cnt: Integer;
  TotalWidth: Integer;
  i: Integer;
begin
  TotalWidth := 0;
  cnt := TheGrid.Columns.Count;
  for i := 0 to cnt - 2 do begin
    TotalWidth := TotalWidth + TheGrid.Columns[i].Width;
  end;
  TheGrid.Columns[cnt - 1].Width := TheGrid.ClientWidth - TotalWidth - 50;
end;

procedure TMyForm.FormResize(Sender: TObject);
begin
  ResizeGridColumns;
end;

procedure TMyForm.TheDatasetCalcFields(Dataset: TDataSet);
var
  Von: TdzNullableTime;
  Bis: TdzNullableTime;
begin
  Von.AssignVariant(Dataset['seVon']);
  Bis.AssignVariant(Dataset['seBis']);
  Dataset.FieldByName('Stunden').Value := (Bis - Von).ToHourStr(2);
end;

(TdzNullableTime is an extended record type from my dzlib library which is available from sourceforge if you are interested. It is declared in u_dzNullableTime.pas.

 Posted by on 2014-07-12 at 17:42