Jack of all trades, master of some…

Archive for October, 2006

There are 3 obvious ways of iterating through each item in a generic list, but which is the most efficient.

1. using a for statement
2. using a foreach statement
3. using the List.ForEach method with a delegate

I created the following simple application to test the differences:

    {

        List<ListItem> items = new List<ListItem>();

        ProfileTimer timer = new ProfileTimer();

        public Form1()

        {

            InitializeComponent();

        }

        private void buttonAllocate_Click(object sender, EventArgs e)

        {

            int itemCount = (int)numericUpDown1.Value;

            textBox1.Clear();

            textBox1.AppendText("Allocating " + itemCount.ToString() + " items.\n");

            items.Capacity = itemCount;

            timer.Start();

            for (int i = 0; i < itemCount; i++)

            {

                items.Add(new ListItem());

            }

            timer.End();

            textBox1.AppendText("Took:" + timer.TimeTaken().ToString() + "\n");

        }

        private void buttonForLoop_Click(object sender, EventArgs e)

        {

            textBox1.AppendText("----------------------------------------------\n");

            textBox1.AppendText("Iterating with for loop\n");

            timer.Start();

            int itemCount = items.Count;

            for (int i = 0; i < itemCount; i++)

            {

                items[i].Value++;

            }

            timer.End();

            textBox1.AppendText("Took:" + timer.TimeTaken().ToString() + "\n");

        }

        private void ButtonForEachStatement_Click(object sender, EventArgs e)

        {

            textBox1.AppendText("----------------------------------------------\n");

            textBox1.AppendText("Iterating with foreach\n");

            timer.Start();

            foreach(ListItem item in items)

            {

                item.Value++;

            }

            timer.End();

            textBox1.AppendText("Took:" + timer.TimeTaken().ToString() + "\n");

        }

        private void buttonForEachDelegate_Click(object sender, EventArgs e)

        {

            textBox1.AppendText("----------------------------------------------\n");

            textBox1.AppendText("Iterating with foreach delegate\n");

            timer.Start();

            items.ForEach(delegate(ListItem item)

                {

                    item.Value++;

                }

            );

            timer.End();

            textBox1.AppendText("Took:" + timer.TimeTaken().ToString() + "\n");

        }

    }

    class ListItem

    {

        public int Value;

    }

The following results were obtained in Seconds 

Tests run on an Intel Pentium Dual Core 3.2GHz  with 3Gb Ram.

As we can see the choice of iterator makes very little difference when there are a small amount of items in the list, but as we move upto iterating lists containing hundreds of thousands of items, there are some performance improvements between the methods.

The For statement out performs the rest, 71% faster than the ForEach Statement, but it should be noted that the itemcount check in the for loop needs to be stored and not checked on each iteration. i.e. don’t use for(int i=0; i<items.count;i++) If the items.count is called on every iteration the perfromace is the same as the ForEach Delegate.

The ForEach delegate comes in second, 39% faster than the ForEach Statement.

Conclusion

For most applications there is not much performance impact in the iteration times, but if time is critical or you have nested iterations then you should be using a basic for loop (BUT rememeber to store the limit in an integer and use in the comparison and DONT allocate a new ListItem variable in the iterator). 

Personally, having come from a delphi background and tending to use the iterator pattern, I’ll be using the ForEach delegate. I think it reads nicer and gets a reasonable performance.

As covered in a previous article, you can overrride the IsInputKey method on a control to inform winforms that you require keyboard event notification for special keys like tabe and cursor keys which are used but the hosting form for control navigation.

When writing a control, I was trying to capture the SHIFT – Right Cursor combination. I already had the following implementation in IsInputKey

switch (keyData)
{
	case Keys.Up:
	case Keys.Down:
	case Keys.Left:
	case Keys.Right:
	case Keys.Home:
	case Keys.End:
	{
	return true;
	}
}
return base.IsInputKey(keyData);

However, althought control-Right and Alt-Right events came through Shift-Right wouldn’t. These were passed to the base implementation which returned true to be handled by the control but fals for the shift right.

So to force the processing of keys irrespective of the key modifiers simply change the case statement to read

            switch (keyData & ~Keys.Modifiers)

Which removes the modifier bit flags from the keydata for the switch comparison.

Focus returns a boolean to indicate whether or not a control has focus or not, but when trying to paint your own focus rectangle in your control and you have allowed your controls scrollbars to accept focus, then the Focus property will return false. 

Instead of using Focus, check the ContainsFocus property that returns true if the control or a child control has focus.

To create a transparent splashscreen, like for example the splash displayed when adobe acrobat reader starts, do the following:

1. Create the a new form
2. Set the Border Style to bsNone
3. Set the Position to poScreenCenter
4. Overide the create constuctor and add the line Brush.Style = bsClear
5. Override the createparams method and add the line
   Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT +WS_EX_TOPMOST;
   after the call to inherited
6. Add an image componet to the form and load your transparent image into it. I use PNG’s rather than bitmaps with a transparent color.  PNGImage (a PNG wrapper for TPicture is available at sourceforge).
7. Set the image and form’s Autosize to true.
8. Slap on a timer to close the form after a couple of seconds.

I can’t remember where I found this code, if I come across the site again, I’ll put a credit to it in this article. 
When trying to load / save PNG Images from a stream using GDI+ routines to load and save from IStream, there were problems, it turns out with the date/time information returned in the Istream Stats.
The following unit provides a Fixed Stream Adapter that correctly returns the stat information.

unit FixedStreamAdapter;
interface
uses
  classes, sysUtils, activex, windows;
type
  TFixedStreamAdapter = class(TStreamAdapter)
public
function Stat(out statstg: TStatStg;
      grfStatFlag: Longint): HResult; override; stdcall;
end;
implementation

function DateTimeToFileTime(DateTime: TDateTime): TFileTime;
// copied from JclDateTime.pas
const
  FileTimeBase      = -109205.0;
  FileTimeStep: Extended = 24.0 * 60.0 * 60.0 * 1000.0 * 1000.0 *10.0; // 100 nSek per Day
var
  E: Extended;
  F64: Int64;
begin
  E := (DateTime – FileTimeBase) * FileTimeStep;
  F64 := Round(E);
  Result := TFileTime(F64);
end;
function TFixedStreamAdapter.Stat(out statstg: TStatStg; grfStatFlag: Longint): HResult;
Begin
  Result := S_OK;
try
if (@statstg <> nil) then
with statstg do
begin
        FillChar(statstg, sizeof(statstg), 0);
        dwType := STGTY_STREAM;
        cbSize := Stream.size;
        mTime := DateTimeToFileTime(now);
        cTime := DateTimeToFileTime(now);
        aTime := DateTimeToFileTime(now);
        grfLocksSupported := LOCK_WRITE;
end;
except
    Result := E_UNEXPECTED;
end;
end;
end.

If you want to paint a tiled image to a canvas, this routine will do it.

ACanvas – the canvas to paint to

ARect – A TRect of the area to paint to

Offset – A TPoint which specifies the origin that the images should start from. Usually Point(0,0)

AnImage – Any TGraphic

AMode – No Tile, Tile across, Tile down, Tile both, Stretch to Rect

AColor – sets the rect to this color first. – this is best used when using a transparent graphic format such as png or gif

type
  TZ9TileMode = (pmNoRepeat, pmRepeatX, pmRepeatY, pmRepeatXY, pmFitXY ); 
procedure PaintBackground(ACanvas : TCanvas; ARect : TRect; Offset : TPoint; AnImage : TGraphic; AMo
de : TZ9TileMode; BGColor : TColor); 
var
  x, y : integer; 
begin
if (AnImage is TPNGObject) then
begin
    ACanvas.Brush.Color := BGColor; 
    ACanvas.FillRect(ARect); 
end; 
if (AnImage.Width = 0) or (AnImage.Height = 0) then exit; 
case Amode of
    pmRepeatXY : 
begin
      y := Offset.Y; 
while y <= Arect.Bottom do
begin
        x := Offset.X; 
while x <= Arect.Right do
begin
          ACanvas.Draw(x,y,AnImage); 
          inc(x, AnImage.Width); 
end; 
        inc(y, AnImage.Height) 
end; 
end; 
    pmRepeatX : 
begin
      y := Offset.Y; 
      x := Offset.X; 
while x <= Arect.Right do
begin
        ACanvas.Draw(x,y,AnImage); 
        inc(x, AnImage.Width); 
end; 
      ACanvas.Brush.Color := BGColor; 
      ACanvas.FillRect( Rect(ARect.Left,y+AnImage.Height,ARect.Right,ARect.Bottom)); 
end; 
    pmRepeatY : 
begin
      x := Offset.X; 
      y := Offset.Y; 
while y <= Arect.Bottom do
begin
        ACanvas.Draw(x,y,AnImage); 
        inc(y, AnImage.Height) 
end; 
      ACanvas.Brush.Color := BGColor; 
      ACanvas.FillRect( Rect(x + AnImage.width,ARect.top,ARect.Right,ARect.Bottom)); 
end; 
    pmNoRepeat : 
begin
      x := Offset.X; 
      y := Offset.Y; 
      ACanvas.Draw(x,y,AnImage); 
      ACanvas.Brush.Color := BGColor; 
      ACanvas.FillRect( Rect(X+AnImage.width,y+AnImage.Height,ARect.Right,ARect.Bottom)); 
      ACanvas.FillRect( Rect(ARect.left,y+AnImage.Height,X+AnImage.width,ARect.Bottom)); 
      ACanvas.FillRect( Rect(X+AnImage.Width,ARect.Top,ARect.Right,y+AnImage.Height)); 
end; 
    pmFitXY : 
begin
      x := Offset.X; 
      y := Offset.Y;
      ACanvas.StretchDraw(Rect(x,y,x + (ARect.Right-ARect.left), y + (ARect.bottom-ARect.top) ),AnIm
age); 
end; 
end; 
end;

When an interface returns a delegated object that causes an error, the factory or autofactory has not been assigned.

The default implementation of SafeCallException refers to FFactory which, in this case is NIL. Override SafeCallException to fix. In COMOBJ.pas, the SafeCallException procedure refers to FFactory.ErrorID, FFactory.ProgID, etc in the call to HandleSafeCallException. FFactory is nil, causing a AV in the error handler, which causes a Catastrophic Error to be raise.

If you descend your objects from a TFudgedAutoObject which simply overrides the SafeCallException message, you can solve the problem.

function TFudgedAutoObject.SafeCallException(ExceptObject: TObject;ExceptAddr: Pointer): HRESULT;
var
  E: TObject;
  CreateError: ICreateErrorInfo;
  ErrorInfo: IErrorInfo;
begin
  Result := E_UNEXPECTED;
  E := ExceptObject;
if Succeeded(CreateErrorInfo(CreateError)) then
begin
    CreateError.SetGUID(Class_EPO);
    CreateError.SetSource(PWideChar(’MY ERROR SOURCE’));
    CreateError.SetHelpFile(PWideChar(’MY HELPFILE NAME.HLP’));
if E is Exception then
begin
      CreateError.SetDescription(PWideChar(WideString(Exception(E).Message)));
      CreateError.SetHelpContext(Exception(E).HelpContext);
if (E is EOleSysError) and (EOleSysError(E).ErrorCode < 0) then
        Result := EOleSysError(E).ErrorCode;
end;
if CreateError.QueryInterface(IErrorInfo, ErrorInfo) = S_OK then
    SetErrorInfo(0, ErrorInfo);
end;
end;

Comments

Very cool tip!
Written by Guest on 2005-06-08 15:53:46

Written by lummie on 2005-06-09 11:19:00

Use the following function to return them. A quck adaption and you should be able to set them as well. For more values to pass into the function check the current contents of the registry key.

function GetSpecialDir(ValueName : string): String;
//  gets the path to a windows special folder and ensures the trailing backslash is on the path.
//  Some Valid ValueNames are
//  ‘Personal’ – My Documents
//  ‘Desktop’ – User’s Desktop
//  ‘Favorites’ – The User Favorites store
var
  Reg: TRegistry;
begin
  result := ”;
  Reg := TRegistry.Create;
try
    Reg.RootKey := HKey_Current_User;
if Reg.OpenKeyReadOnly(’\Software\Microsoft\Windows\CurrentVersion\Explo
rer\Shell Folders’) then
      result := IncludeTrailingPathDelimiter(Reg.ReadString(ValueName));
finally
    Reg.Free;
end;
end;

Having written your nice COM Object model to allow access to your application, how do you find out if you have neen clearing up the objects correctly and check you are handling zombie objects correctly too.

If you add the following unit to your aplication and descend your comobjects from TTracker instead of TAutoObject, this unit will count the number of addrefs and releases that occur on the object.

All you need to do is call TTrackerlog.dump to get a list of all the objects, the maximum number of instances ever alive and the current number alive.

All we are doing, is overriding the addref and release implementation, and maintaing a list of stats based up on the objects classname.

unit ObjectTracker;
interface
uses
   Classes, SysUtils, ComObj, Contnrs, SyncObjs, ActiveX;
type
   TTrackedItemInfo = (iiCreationOnAdd, iiCreationOnRelease);
   TTrackedItemInfos = set of TTrackedItemInfo;
   TTracker = class (TAutoObject)
     FTrackedClassName: string;
public
constructor create; virtual;
function ObjAddRef: Integer; override; stdcall;
function ObjRelease: Integer; override; stdcall;
end;
   TTrackedItem = class (TObject)
private
     FDesc: string;
     FInfo: TTrackedItemInfos;
     FMaxCount: Integer;
     FMinCount: Integer;
     FObjAddress: Pointer;
     FRefCount: Integer;
public
constructor Create(AnObj : pointer);
procedure AddReference;
procedure RemoveReference;
property Desc: string read FDesc write FDesc;
property Info: TTrackedItemInfos read FInfo write FInfo;
property MaxCount: Integer read FMaxCount;
property MinCount: Integer read FMinCount;
property ObjAddress: Pointer read FObjAddress write FObjAddress;
property RefCount: Integer read FRefCount;
end;
   TTrackerLog = class (TObject)
     FList: TObjectList;
     FLock: TMultiReadExclusiveWriteSynchronizer;
protected
constructor CreateInstance;
class function AccessInstance(Request: Integer): TTrackerLog;
public
constructor Create; virtual;
destructor Destroy; override;
procedure AddReference(AnObj : TObject; TrackedClassName : string);
procedure Dump(const AFilename : widestring);
class function Instance: TTrackerLog;
class procedure ReleaseInstance;
procedure ReleaseReference(AnObj : TObject; TrackedClassName : string);
end;
implementation
{ TTracker }
{
*************************** TTracker ***************************
}
constructor TTracker.create;
begin
inherited;
   FTrackedClassName := Classname;
end;
function TTracker.ObjAddRef: Integer;
begin
   result := inherited ObjAddRef;
   TTrackerLog.Instance.AddReference(self,FTrackedClassName);
end;
function TTracker.ObjRelease: Integer;
begin
   result := inherited ObjRelease;
   TTrackerLog.Instance.ReleaseReference(self,FTrackedClassName);
end;
{ TTrackerLog }
{
**************************** TTrackedItem *************************
}
constructor TTrackedItem.Create(AnObj : pointer);
begin
inherited Create;
   FMinCount := 0;
   FMaxCount := 0;
   FObjAddress := Anobj;
   FRefCount := 0;
   FInfo := [];
end;
procedure TTrackedItem.AddReference;
begin
   inc(FRefCount);
if FMaxCount < FRefCount then FMaxCount := FRefCount;
end;
procedure TTrackedItem.RemoveReference;
begin
   Dec(FRefCount);
if FMinCount > FRefCount then FMinCount := FRefCount;
end;
{
**************************** TTrackerLog ****************************
}
constructor TTrackerLog.Create;
begin
raise Exception.CreateFmt(\’Access class %s through Instance only\’, [ClassName]);
inherited create;
end;
constructor TTrackerLog.CreateInstance;
begin
inherited Create;
   FList := TObjectList.create(true);
   FLock := TMultiReadExclusiveWriteSynchronizer.create;
end;
destructor TTrackerLog.Destroy;
begin
if AccessInstance(0) = Self then AccessInstance(2);
   FreeAndNil(FLock);
   FreeAndNil(FList);
inherited Destroy;
end;
class function TTrackerLog.AccessInstance(Request: Integer): TTrackerLog;
{$WRITEABLECONST ON}
const FInstance: TTrackerLog = nil;
{$WRITEABLECONST OFF}
begin
case Request of
0 : ;
1 : if not Assigned(FInstance) then FInstance := CreateInstance;
2 : FInstance := nil;
else
raise Exception.CreateFmt(\’Illegal request %d in AccessInstance\’, [Request]);
end;
   Result := FInstance;
end;
procedure TTrackerLog.AddReference(AnObj : TObject; TrackedClassName : string);
var
   i: Integer;
   Item: TTrackedItem;
begin
   FLock.BeginWrite;
try
     i := FList.count -1;
while (i >= 0) and (TTrackedItem(FList.items[i]).ObjAddress <> AnObj) do dec(i);
if i = -1 then // not found
begin
       item := TTrackedItem.create(AnObj);
       item.Info := Item.Info + [iiCreationOnAdd];
       item.Desc :=
TrackedClassName;
       Flist.add(item);
end
else
       item := TTrackedItem(FList.items[i]);
     item.AddReference;
finally
   &nbsp
; FLock.EndWrite
end;
end;
procedure TTrackerLog.Dump(const AFilename : widestring);
var
   FName: string;
   i: Integer;
   Item: TTrackedItem;
   fs: TFileStream;
   t: string;
begin
   FLock.BeginRead;
try
//  FName := GetModuleName(HInstance);
//  FName := ChangeFileExt(FName,formatdatetime(\’.hhnnss\’,now)) + \’.csv\’;
     FName := AFilename;
if FList.Count > 0 then
begin
       fs := TFileStream.create(fname,fmCreate);
       t := \’\”Address\”,\”ClassName\”,\”RefCount\&quo
t;,\”Max\”,\”Min\”\’ + #13#10;
       fs.Write(t[1],length(t));
for i := 0 to FList.count -1 do
begin
         item := TTrackedItem(FList.items[i]);
         t := format(\’\”%x\”,\”%s\”,%d,%d,%d\’,[integer(item.
ObjAddress),item.Desc, item.RefCount, item.MaxCount, item.MinCount]) + #13#10;
         fs.Write(t[1],length(t));
end;
       fs.free;
end;
finally
     FLock.EndRead;
end;
end;
class function TTrackerLog.Instance: TTrackerLog;
begin
   Result := AccessInstance(1);
end;
class procedure TTrackerLog.ReleaseInstance;
begin
   AccessInstance(0).Free;
end;
procedure TTrackerLog.ReleaseReference(AnObj : TObject; TrackedClassName : string);
var
   i: Integer;
   Item: TTrackedItem;
begin
   FLock.BeginWrite;
try
     i := FList.count – 1;
while (i >= 0) and (TTrackedItem(FList.items[i]).ObjAddress <> AnObj) do dec(i);
if i = -1 then // not found
begin
       item := TTrackedItem.create(AnObj);
       item.Info := Item.Info + [iiCreationOnRelease];
       item.Desc := TrackedClassName;
       Flist.add(item);
end
else
       item := TTrackedItem(FList.items[i]);
     item.RemoveReference;
finally
     FLock.EndWrite
end;
end;
initialization
finalization
if TTrackerLog.Instance <> nil then TTrackerLog.ReleaseInstance;
end.

The object inspector has an inbuilt ability to edit any TPersistent based object.
It uses RTTI to inspect the published properties of the TPersistent descendant and displays them as an expandable property. This is how the constraints property is implemented for example.

The following unit provides an implementation of an editable TRect. I use this in controls for specifing margins for example.

unit PersistentRect;
interface
uses
   Classes, SysUtils, types;
type
   TPersistentRect = class(TPersistent)
private
     FRect : TRect;
     FOnChange: TNotifyEvent;
function GetRect: TRect;
procedure SetRect(const Value: TRect);
procedure SetRectBottom(const Value: integer);
procedure SetRectLeft(const Value: integer);
procedure SetRectRight(const Value: integer);
procedure SetRectTop(const Value: integer);
protected
procedure AssignTo(Dest: TPersistent); override;
public
property AsRect : TRect read GetRect Write SetRect;
constructor create; virtual;
published
property Left : integer read FRect.Left write SetRectLeft;
property Top : integer read FRect.Top write SetRectTop;
property Right : integer read FRect.Right write SetRectRight;
property Bottom : integer read FRect.Bottom write SetRectBottom;
property OnChange : TNotifyEvent read FOnChange write FOnChange;
end;
implementation
{ TPersistentRect }
procedure TPersistentRect.AssignTo(Dest: TPersistent);
begin
if Dest is TPersistentRect then
with TPersistentRect(Dest) do
begin
       AsRect := Self.AsRect;
end
else inherited AssignTo(Dest);
end;
constructor TPersistentRect.create;
begin
inherited;
   FOnChange := nil;
end;
function TPersistentRect.GetRect: TRect;
begin
   result := FRect;
end;
procedure TPersistentRect.SetRect(const Value: TRect);
begin
   FRect.Left := value.left;
   FRect.top := value.top;
   FRect.right := value.right;
   FRect.bottom := value.bottom;
if assigned(FOnChange) then FOnChange(self);
end;
procedure TPersistentRect.SetRectBottom(const Value: integer);
begin
   FRect.Bottom := Value;
if assigned(FOnChange) then FOnChange(self);
end;
procedure TPersistentRect.SetRectLeft(const Value: integer);
begin
   FRect.Left := Value;
if assigned(FOnChange) then FOnChange(self);
end;
procedure TPersistentRect.SetRectRight(const Value: integer);
begin
   FRect.Right := Value;
if assigned(FOnChange) then FOnChange(self);
end;
procedure TPersistentRect.SetRectTop(const Value: integer);
begin
   FRect.Top := Value;
if assigned(FOnChange) then FOnChange(self);
end;
end.

Example of usage
In the Component that you want an editable rect for add the following :

 TPanelWithMargins = class(TCustomPanel)
private
{ Private declarations }
     FMargins: TPersistentRect;
protected
{ Protected declarations }
procedure MarginsChanged(Sender : TObject);
procedure AdjustClientRect(var Rect: TRect); override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Margins : TPersistentRect read FMargins write FMargins;
end;
procedure TPanelWithMargins.AdjustClientRect(var Rect: TRect);
begin
inherited;
   Rect.Left := rect.Left + FMargins.Left;
   Rect.Top := rect.top + FMargins.Top;
   Rect.Right := rect.Right – FMargins.Right;
   Rect.Bottom := rect.Bottom – FMargins.Bottom;
end;
constructor TPanelWithMargins.Create(AOwner: TComponent);
begin
inherited;
   FMargins := TPersistentRect.create;
   FMargins.OnChange := MarginsChanged;
   FMargins.AsRect := Rect(2,2,2,2);
end;
destructor TPanelWithMargins.Destroy;
begin
   FreeAndNil(FMargins);
inherited;
end;
procedure TPanelWithMargins.MarginsChanged(Sender: TObject);
begin
   Realign;
end;