Delphi

Creating Threads in Delphi 2010

If you'll upgrade to Delphi 2010, you'll quickly notice that old code you were using to create threads, such as

constructor TMyThread.Create;
begin
  inherited Create({CreateSuspended}true);
 // must create event handle first!
  FEventHandle := CreateEvent(
          {security}      nil,
          {bManualReset}  true,
          {bInitialState} false,
          {name}          nil);
  Resume;
end;

now produces a warning:

[DCC Warning] xxx.pas(277): W1000 Symbol ‘Resume’ is deprecated

Of course, you can change Resume to Start and it will work, but that's not a proper way to create threads. The proper way would be:

constructor TMyThread.Create;
begin
 // create event handle first!
  FEventHandle := CreateEvent(
          {security}      nil,
          {bManualReset}  true,
          {bInitialState} false,
          {name}          nil);
  inherited Create({CreateSuspended}false);
end;

The trick is that Delphi does not require "inherited Create" to be the first statement in descendant constructor body.

Calling TObject.Create from descendant constructor does not create an object and does not write zeros to all of object fields. It is TObject.NewInstance method that does that.

The call "fMyThread := TMyThread.Create;" is actually compiled into two calls:

  1. The 1st compiled call is to TObject.NewInstance() method; this method allocates memory and initializes the fields
  2. The 2nd compiled call is to TMyThread.Create, invoked as any other regular method.

The same principle also applies to Destroy and FreeInstance methods: calling ancestor Destroy is not required to be the last statement of destructor's body.

System Font in InputQuery Delphi Function

If you have applied my techniques fixing Large Fonts and System Font to all forms in your Delphi application, most likely there will be two forms still untouched. These will be the forms hidden inside MessageDlg and InputQuery VCL functions.

Fortunately, MessageDlg supports Large Fonts and System Font ok, but InputQuery supports only Large Fonts. In this post I will show how to modify InputQuery to support System Font.

Screenshot: Original InputQuery when System Font is Tahoma, DPI=120

InputQuery not supporting System Font

InputQuery implementation is hidden inside VCL, so a patch to VCL source code is needed.

  1. Locale Dialogs.pas unit in VCL source folder
  2. Save As Dialogs.pas to project folder using NewDialogs.pas file name
  3. Go to Project/Options/Directories/Conditionals/Aliases/Unit Aliases and define new unit alias: Dialogs=NewDialogs
  4. Locate InputQuery function in implementation part of NewDialogs.pas unit
  5. Insert code from previous post System Font right before "if ShowModal = mrOk then" line
  6. Build the project

The resulting InputQuery window will look like:

New InputQuery supporting System Font

System Font in Delphi Applications

Most Delphi applications are using MS Sans Serif 8 as their default font, meanwhile Windows XP system font is Tahoma 8.25 and Windows Vista system font is Segoe UI.

Below code makes Delphi applications use Windows system font:

procedure TForm1.FormCreate(Sender: TObject);
var
  NonClientMetrics: TNonClientMetrics;
begin
  NonClientMetrics.cbSize := SizeOf(NonClientMetrics);
  SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0);
  Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
  if Scaled then
  begin
    Font.Height := NonClientMetrics.lfMessageFont.lfHeight;
  end;
end;

Large Fonts in Delphi Applications

99% of Delphi applications I have seen, do not support Large Fonts, or support it very badly. There is a Scaled property in TForm, people think it is about to scale the form in case of non-default DPI setting, but it is just not working properly.

Below code scales TForm the correct way:

procedure TForm1.FormCreate(Sender: TObject);
begin   
  Assert(not Scaled, 'TForm.Scaled property sucks, you should set it to False!');   
  if Screen.PixelsPerInch <> PixelsPerInch then
  begin     
    ScaleBy(Screen.PixelsPerInch, PixelsPerInch);   
  end; 
end;

Delphi stores design-time DPI of a form in PixelsPerInch property. This code handles scaling correctly even if some forms are designed in 96 DPI, and some forms in 120 DPI.

Object-oriented Windows API

Windows API functions are declared in structured programming style.

For example consider classical example of using critical sections:

procedure Test;
var 
  CS: TCriticalSection;
begin
  InitializeCriticalSection(CS);
  try
    EnterCriticalSection(CS);
    try
      //somecode
    finally
      LeaveCriticalSection(CS);
    end;
  finally
    DeleteCriticalSection(CS);
  end;
end;

Now consider the example rewritten in object-oriented Windows API:

procedure Test;
var
  NewCS: TNewCriticalSection;
begin
  NewCS.Initialize;
  try
    NewCS.Enter;
    try
      //somecode
    finally
      NewCS.Leave;
    end;
  finally
    NewCS.Delete;
  end;
end;

Bespoke the code is easier to read, the benefit is CodeInsight works nicely — type "NewCS." and press Control+Space…

Below unit implements new object-oriented Windows API:

unit NewWindows;

interface

uses Windows;

{$HINTS OFF}
type
  TNewCriticalSection = object
  private
    FOldCriticalSection: TRTLCriticalSection;
  public
    procedure Initialize; stdcall;
    procedure Delete; stdcall;
    procedure Enter; stdcall;
    procedure Leave; stdcall;
  end;
{$HINTS ON}
  
implementation

procedure TNewCriticalSection.Initialize; 
    external kernel32 name 'InitializeCriticalSection';
procedure TNewCriticalSection.Delete; 
    external kernel32 name 'DeleteCriticalSection';
procedure TNewCriticalSection.Enter; 
    external kernel32 name 'EnterCriticalSection';
procedure TNewCriticalSection.Leave; 
    external kernel32 name 'LeaveCriticalSection';

end. 

The trick is that Delphi object types are passed by value, hence when calling TNewCriticalSection.Initialize method, FOldCriticalSection field is occupying on the stack the same place argument of InitializeCriticalSection would do. Thus we can declare implementation of TNewCriticalSection.Initialize as external from kernel32.dll.

FastCode Library for Delphi

If you believe you've optimized your Delphi application to the max, and there is no room for performance improvement, then you should check out following site: http://sourceforge.net/projects/fastcode

Project Fastcode is competition of assembler developers on rewriting certain Delphi RTL functions to processor-specific code, utilizing extra instruction sets like SSE, SSE2, etc. This way Fastcode winners achieve 2x-4x performance boost compared to classic i386 implementations.

Each function in Fastcode project has 5 variants, each variant is optimized for certain processor architecture:

  • {function_name}_Blended - optimized for <= Pentium processors (employs i386, MMX instruction sets)
  • {function_name}_Pentium3 - optimized for Pentium 3 processors (employs i386, MMX, SSE)
  • {function_name}_Pentium4Northwood - optimized for Pentium 4 processors, Northwood kernel (employs i386, MMX, SSE, SSE2)
  • {function_name}_Pentium4Presscot - optimized for Pentium 4 processors, Presscot kernel (employs i386, MMX, SSE, SSE2, SSE3)
  • {function_name}_AthlonXP - optimized for Athlon XP (employs 3D-Now)
  • {function_name}_Opteron - optimized for Opteron (employs ???)

I have put together a package allowing you start on using Fastcode just in 5 mins. It contains units that auto-determine your CPU type and auto-patch VCL to use Fastcode. The following Fastcode functions are included:

  • Move - 200% performance boost
  • FillChar - 200-400% performance boost
  • Pos - 200-300% performance boost
  • CompareText - 200% performance boost

I recommend using this package in non-GUI application servers, facilitating strong memory usage, etc.

Despite it will not make your application incredibly fast, overall speed up will be about 5%.

Writing TPanelForm

Question/Problem/Abstract:

Make TPanel designable likewise TForm & TDataModule...

Answer:

unit PanelForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, ComCtrls;

type
  TPanelForm = class(TPanel)
  private
    FOnCreate: TNotifyEvent;
    FOnDestroy: TNotifyEvent;
  protected
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  public
    constructor Create(AOwner: TComponent); override;
    constructor CreateNew(AOwner: TComponent);
    destructor Destroy; override;
  published
    property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
  end;

implementation

uses
  Consts;

procedure TPanelForm.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  I: Integer;
  OwnedComponent: TComponent;
begin
  inherited GetChildren(Proc, Root);
  if Root = Self then
    for I := 0 to ComponentCount - 1 do
    begin
      OwnedComponent := Components[I];
      if not OwnedComponent.HasParent then Proc(OwnedComponent);
    end;
end;

constructor TPanelForm.Create(AOwner: TComponent);
begin
  CreateNew(AOwner);
  if (ClassType <> TPanelForm) {and not (csDesigning in ComponentState)} then
    if not InitInheritedComponent(Self, TPanelForm) then
      raise EResNotFound.CreateFmt(SResNotFound, [ClassName]);
  try
    if Assigned(FOnCreate) then FOnCreate(Self);
  except
    Application.HandleException(Self);
  end;
end;

constructor TPanelForm.CreateNew(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TPanelForm.Destroy;
begin
  if Assigned(FOnDestroy)
    then FOnDestroy(Self);
  inherited;
end;

end.
 unit xFormsReg;

interface

procedure Register;

implementation

uses
  DsgnIntf, Classes, PanelForm;

procedure Register;
begin
  RegisterCustomModule(TPanelForm, nil);
  RegisterClass(TPanelForm);
end;

end.
package xForms;

requires
  vcl40;

contains
  PanelForm,
  xFormsReg;

end.

There is no standard way to create such panel forms. Just create new form, change its ancestor from TForm to TPanelForm and press Alt+F12 two times.

Good luck !

Syndicate content