Delphi XE4 is delivered with 3 sets of Microsoft Office components (Word, Excel, Outlook, Power Point and Access): Office 2000, Office XP and Office 2010. None is installed by default.
To install Office components, you must launch the IDE, select "Component" menu and then "Install packages". In the list shown, you'll find "Microsoft Office 200 sample Automation Server Wrapper Components" and similar for XP. You don't see the package for office 2010 but it is delivered.
If you need Office XP or office 2000, just click the check box in front of the corresponding item in the list then click OK.
If you need Offcie 2010, click the "Add..." button below the list and navigate to "Program Files (x86)\Embarcadero\RAD Studio\11.0\bin" and select "dcloffice2010180.bpl". then click OK.
After installation of any one of the Office component package, you'll have a new tab "Servers" in the component palette with all the Office component wrappers.
By the way, always select the oldest version you can use because it will work with more recent Office version. Of course you can use recent Office functions only with recent component wrapper, but then your application will not work if an old Microsoft Office is installed.
Recommanded reading: "Automate Microsoft Office from Delphi" article available from my blog at http://francois-piette.blogspot.be/2013/01/automate-microsoft-office-from-delphi.html
Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
April 30, 2013
Getting Network Share List
Network neighborhood can be obtained programmatically in any application. It’s just a matter of a single Windows API call to the NetShareEnum function.
MSDN publish the complete description of NetShareEnum at http://msdn.microsoft.com/en-us/library/windows/desktop/bb525387(v=vs.85).aspx
Since Delphi doesn’t provide the definition, we have to define it our self. With the help of MSDN we find that NetShareEnum is defined for C/C++ language into Lmshare.h and the function is implemented in Netapi32.dll.
Lmshare.h can be found in Windows SDK which is a free download from Microsoft.
But don’t worry; I’ve done the work for you!
ServerName points to a Unicode string that specifies the DNS or NetBIOS name of the remote computer. Use nil to specify the local computer. It works with the name beginning with two backslashes or just the server name.
Level is an integer which defines which information you want to retrieve. In this sample, we will use the basic level of information which is level 1.
BufPtr is a variable which will be filled by the API with the address of a buffer where the requested information has been copied. This buffer must be freed later using NetApiBufferFree. BufPtr is defined as an untyped pointer since the actual data type change according to the level argument.
PrefMaxLen specifies the preferred maximum length of returned data. A special value (-1) specifies that the function allocate the amount of memory required for the data. There is practical reason to not use that value since all computers have plenty of RAM today.
EntriesRead returns the number of entries returned in the buffer.
TotalEntries receive the total number of entries. Useful if PrefMaxLength is too small. But Microsoft says it is only a hint.
ResumeHandle is a handle which can be used to resume an interrupted enumeration. Should be set to zero for the first call to the function.
The return value is an error code. Actually the NET_API_STATUS is simply a DWORD.
We saw that NetShareEnum is allocating memory for use and that this memory must be freed using NetApiBufferFree. This new API function is defined in the same file. Here is his Delphi declaration:
To be able to effectively use NetShareEnum, we still need the data type declaration. You can see on MSDN the various levels (see link above). We will use basic information which is level 1:
shi1_netname is the name of the network share, the one you see using Windows own Explorer.
shi1_type is a bit mask which defines what the share is, for example a disk or a printer.
shi1_remark is the description given when the share has been created on the server.
It’s time now to use NetShareEnum in a real program. Create a new VCL form application; drop a button and a TMemo on it. Use the code below.
This code is really simple. Isn’t it? There is a call to NetShareEnum and then a loop to iterate thru all the record returned in the buffer, displaying the share name and share type. Finally, NetApiBufferFree is called to release the memory allocated by NetShareEnum.
I created a small function to decode the share type:
I should be clear to you that you have to call the nice function from the button onclick event handler like this:
In that demo, ‘ML150’ is the name of a server on my network. Use an appropriate name for your network. Or an empty string to list the shares on the local computer.
A last note: this code has been built using Delphi XE4. It should work unchanged with all Unicode enabled version of Delphi (2009 and up). For older Delphi, you have to pay attention to Unicode strings that the API is using and convert it to Ansi strings.
This article is available from:
http://francois-piette.blogspot.be/2013/04/getting-network-share-list.html
Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
MSDN publish the complete description of NetShareEnum at http://msdn.microsoft.com/en-us/library/windows/desktop/bb525387(v=vs.85).aspx
Since Delphi doesn’t provide the definition, we have to define it our self. With the help of MSDN we find that NetShareEnum is defined for C/C++ language into Lmshare.h and the function is implemented in Netapi32.dll.
Lmshare.h can be found in Windows SDK which is a free download from Microsoft.
But don’t worry; I’ve done the work for you!
function NetShareEnum(ServerName : PWideChar;
Level : DWORD;
var BufPtr : Pointer;
PrefMaxLen : DWORD;
var EntriesRead : DWORD;
var TotalEntries : DWORD;
var ResumeHandle : DWORD) : NET_API_STATUS; stdcall;
external 'NetAPI32.dll' name 'NetShareEnum';
ServerName points to a Unicode string that specifies the DNS or NetBIOS name of the remote computer. Use nil to specify the local computer. It works with the name beginning with two backslashes or just the server name.
Level is an integer which defines which information you want to retrieve. In this sample, we will use the basic level of information which is level 1.
BufPtr is a variable which will be filled by the API with the address of a buffer where the requested information has been copied. This buffer must be freed later using NetApiBufferFree. BufPtr is defined as an untyped pointer since the actual data type change according to the level argument.
PrefMaxLen specifies the preferred maximum length of returned data. A special value (-1) specifies that the function allocate the amount of memory required for the data. There is practical reason to not use that value since all computers have plenty of RAM today.
EntriesRead returns the number of entries returned in the buffer.
TotalEntries receive the total number of entries. Useful if PrefMaxLength is too small. But Microsoft says it is only a hint.
ResumeHandle is a handle which can be used to resume an interrupted enumeration. Should be set to zero for the first call to the function.
The return value is an error code. Actually the NET_API_STATUS is simply a DWORD.
We saw that NetShareEnum is allocating memory for use and that this memory must be freed using NetApiBufferFree. This new API function is defined in the same file. Here is his Delphi declaration:
function NetApiBufferFree(Buffer : Pointer) : NET_API_STATUS; stdcall;
external 'NetAPI32.dll' name 'NetApiBufferFree';
To be able to effectively use NetShareEnum, we still need the data type declaration. You can see on MSDN the various levels (see link above). We will use basic information which is level 1:
type
SHARE_INFO_1 = record
shi1_netname : PWideChar;
shi1_type : DWORD;
shi1_remark : PWideChar;
end;
PSHARE_INFO_1 = ^SHARE_INFO_1;
shi1_netname is the name of the network share, the one you see using Windows own Explorer.
shi1_type is a bit mask which defines what the share is, for example a disk or a printer.
const
STYPE_DISKTREE = 0;
STYPE_PRINTQ = 1;
STYPE_DEVICE = 2;
STYPE_IPC = 3;
STYPE_TEMPORARY = $40000000;
STYPE_SPECIAL = $80000000;
shi1_remark is the description given when the share has been created on the server.
It’s time now to use NetShareEnum in a real program. Create a new VCL form application; drop a button and a TMemo on it. Use the code below.
procedure TForm1.EnumerateShares1(
const Server : PChar;
const Pfx : String = '');
const
MAX_PREFERRED_LENGTH = -1;
NERR_SUCCESS = 0;
var
EntriesRead : DWORD;
TotalEntries : DWORD;
ResHandle : DWORD;
ShareInfo1 : PSHARE_INFO_1;
P : PSHARE_INFO_1;
Status : NET_API_STATUS;
I : Integer;
begin
ResHandle := 0;
Status := NetShareEnum(Server, 1, Pointer(ShareInfo1),
DWORD(MAX_PREFERRED_LENGTH),
EntriesRead, TotalEntries, ResHandle);
try
if Status <> NERR_SUCCESS then
Exit;
P := ShareInfo1;
for I := 0 to TotalEntries - 1 do begin
Memo1.Lines.Add(Pfx + P.shi1_netname +
' ' + ShareTypeToStr(P.shi1_type));
Inc(P);
end;
finally
NetApiBufferFree(ShareInfo1);
end;
end;
This code is really simple. Isn’t it? There is a call to NetShareEnum and then a loop to iterate thru all the record returned in the buffer, displaying the share name and share type. Finally, NetApiBufferFree is called to release the memory allocated by NetShareEnum.
I created a small function to decode the share type:
function ShareTypeToStr(SType : DWORD) : String;
begin
case SType and $FFFF of
STYPE_DISKTREE: Result := '[Disk]';
STYPE_PRINTQ: Result := '[Printer]';
STYPE_DEVICE: Result := '[Device]';
STYPE_IPC: Result := '[IPC]';
else
Result := '[Type0x' + IntToHex(SType, 8) + ']';
end;
if (SType and STYPE_SPECIAL) <> 0 then
Result := Result + '[Special]';
if (STYpe and STYPE_TEMPORARY) <> 0 then
Result := Result + '[Temporary]';
end;
I should be clear to you that you have to call the nice function from the button onclick event handler like this:
procedure TForm1.Button1Click(Sender: TObject);
begin
EnumerateShares1('ML150');
end;
In that demo, ‘ML150’ is the name of a server on my network. Use an appropriate name for your network. Or an empty string to list the shares on the local computer.
A last note: this code has been built using Delphi XE4. It should work unchanged with all Unicode enabled version of Delphi (2009 and up). For older Delphi, you have to pay attention to Unicode strings that the API is using and convert it to Ansi strings.
This article is available from:
http://francois-piette.blogspot.be/2013/04/getting-network-share-list.html
Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
April 29, 2013
Delphi XE4 and AnsiString
I already ported a lot of my applications to Delphi XE4. This represent hundreds of thousands lines of code. All in all this was very easy, coming from XE3.
There is only one changed feature that forced me to slightly update my source code: in XE4, all AnsiString routines have been moved to a new unit named System.AnsiStrings. I had to add this unit where ever I used on of those routines. If you don't, XE4 gives a warning about deprecated function:
Given the code:
You get the warning:
Sadly, if you add System.AnsiStrings to the uses clause and recompile the code, you get the warning:
I don’t clearly understand why the compiler emit this warning because as you see, the two overloaded versions of StrLen are the same!
To avoid this issue, you have to fully qualify StrLen like this:
I have to produce code working for several Delphi versions. So I designed a little workaround so that change in my existing source code is mimimal. I wrote a new _StrLen function which has the required conditional compilation to make it works with all Delphi versions. And everywhere I call StrLen, I replaced it by _StrLen. This is easy to find since the compiler complain at each instance.
What I explained here about StrLen occurs with many other ANSI strings routines. Same solution applies to all.
This article is available from:
http://francois-piette.blogspot.be/2013/04/delphi-xe4-and-ansistring.html
Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
There is only one changed feature that forced me to slightly update my source code: in XE4, all AnsiString routines have been moved to a new unit named System.AnsiStrings. I had to add this unit where ever I used on of those routines. If you don't, XE4 gives a warning about deprecated function:
Given the code:
procedure TForm1.Button1Click(Sender: TObject);
var
S : AnsiString;
L : Integer;
begin
S := 'Hello world!';
L := StrLen(PAnsiChar(S));
end;
You get the warning:
[dcc32 Warning] Unit1.pas(32): W1000 Symbol 'StrLen' is deprecated: 'Moved to the AnsiStrings unit'
Sadly, if you add System.AnsiStrings to the uses clause and recompile the code, you get the warning:
[dcc32 Error] Unit1.pas(33): E2251 Ambiguous overloaded call to 'StrLen'
System.SysUtils.pas(10369): Related method:
function StrLen(const PAnsiChar): Cardinal;
System.AnsiStrings.pas(3166): Related method:
function StrLen(const PAnsiChar): Cardinal;
I don’t clearly understand why the compiler emit this warning because as you see, the two overloaded versions of StrLen are the same!
To avoid this issue, you have to fully qualify StrLen like this:
procedure TForm1.Button1Click(Sender: TObject);
var
S : AnsiString;
L : Integer;
begin
S := 'Hello world!';
L := System.AnsiStrings.StrLen(PAnsiChar(S));
end;
Unfortunately, this makes the code not compilable anymore with previous Delphi versions. XE3 has an AnsiStrings unit but without StrLen.I have to produce code working for several Delphi versions. So I designed a little workaround so that change in my existing source code is mimimal. I wrote a new _StrLen function which has the required conditional compilation to make it works with all Delphi versions. And everywhere I call StrLen, I replaced it by _StrLen. This is easy to find since the compiler complain at each instance.
function _StrLen(const S : PAnsiChar): Cardinal;
begin
{$IFDEF VER250}
Result := System.AnsiStrings.StrLen(S);
{$ELSE}
Result := StrLen(S);
{$ENDIF}
end;
In the uses clause, I have this:uses
Windows, Messages,
{$IFDEF VER250}
System.AnsiStrings,
{$ENDIF}
SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
Please note that in order to say compatible with very old Delphi versions such as Delphi 7, I don’t use prefixes and instead I use the “unit scope name” in the project options so that the compiler properly resolve “SysUtils” to “System.SysUtils” and the likes for compilers which supports unit scope naming. Anyway, almost all my source code was already written that way because most of it exists long before Delphi supported that feature.What I explained here about StrLen occurs with many other ANSI strings routines. Same solution applies to all.
This article is available from:
http://francois-piette.blogspot.be/2013/04/delphi-xe4-and-ansistring.html
Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
April 27, 2013
Enabling floating form designer in Delphi XE4
Delphi XE4 has an interesting feature removed from previous versions: the floating VCL form designer. You can enable it again easily, at your own risk.
While the IDE is not running, launch the registry editor, locate the key HKEY_CURRENT_USER\Software\Embarcadero\BDS\11.0\Form Design and set the "Embedded Designer" to False.
Note: Don't do that if you use FireMonkey. It's form designer doesn't work when floating.
If you need sometimes to have the floating form designer and sometimes not, you way ask the IDE to load his options from another registry key. Use the "-r MyRegKey" in a new shortcut to BDS.EXE. The first time you launch Delphi with that option, the registry key is created with a copy of the current standard key. You can then change the options without affecting the standard registry key. You can also change packages and so on.
 |
| Screen dump of my typical Delphi desktop during development (Dual full HD 24" screen) |
Please share this article as much as possible in the hope Embarcadero will again enable this incredibly useful feature.
This article is available from:
http://francois-piette.blogspot.be/2013/04/enabling-floating-form-designer-in.html
Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
April 23, 2013
Delphi XE4 is available
With Embarcadero RAD Studio XE4 you can create true native apps for PCs, tablets, and smartphones from a single code base, and get them to markets and users fast. True native apps run directly on the device, getting full access to all underlying capabilities, tighter security, and a better user experience. Try it! http://embt.co/RADXE4Trial
Now you have one set of development tools to create true native apps that are compiled and optimized for multiple device platforms. Project complexity is reduced — one codebase, one team, and one Schedule.
Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
April 22, 2013
Serial Port Programming RS232 / RS485
Using the serial port is a common task and there are a huge number of components for doing that.
I'm using TCiaComPort by Wilfried Mestdagh for years. It is a freeware with source code available at: http://www.mestdagh.biz/soft_components.html
Recently, I have updated the source code for Unicode enabled Delphi versions. I use it with Delphi XE3 but it should be OK starting from D2009.
My use is for industrial applications where I have to control devices using either RS232 or RS485. The same TCiaComPort may be used for both since programmatically both RS232 and RS485 appears as a serial COM port.
Just a little note about RS485: When using RS485 for multiple devices, the communication is done on a bus. That is only one device can talk at a time. You must be sure to respect that behaviour. Usually on the RS485 bus, there is one master (Frequently the PC) and one or more slaves (The devices). You have to study the communication protocol used by the devices. Frequently it is a command / response style protocol. The master send a command to one device which in turn replies. So it is easy to avoid communicating simultaneously: just wait for the reply before sending the next command.
Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
This article is available from http://francois-piette.blogspot.be/2013/04/serial-port-programming-rs232-rs485.html
I'm using TCiaComPort by Wilfried Mestdagh for years. It is a freeware with source code available at: http://www.mestdagh.biz/soft_components.html
Recently, I have updated the source code for Unicode enabled Delphi versions. I use it with Delphi XE3 but it should be OK starting from D2009.
My use is for industrial applications where I have to control devices using either RS232 or RS485. The same TCiaComPort may be used for both since programmatically both RS232 and RS485 appears as a serial COM port.
Just a little note about RS485: When using RS485 for multiple devices, the communication is done on a bus. That is only one device can talk at a time. You must be sure to respect that behaviour. Usually on the RS485 bus, there is one master (Frequently the PC) and one or more slaves (The devices). You have to study the communication protocol used by the devices. Frequently it is a command / response style protocol. The master send a command to one device which in turn replies. So it is easy to avoid communicating simultaneously: just wait for the reply before sending the next command.
Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
This article is available from http://francois-piette.blogspot.be/2013/04/serial-port-programming-rs232-rs485.html
April 20, 2013
TabOrder blues
In every Windows form, the user is allowed to use the tab key to cycle thru all controls on the form. When building a form, the developer can select the tab order to fit his needs. For example if the form looks like a grid, he set tab order so that the focus goes horizontally first. Alternatively, he can select that controls are visited in column order. Of course the crazy developer can select any order.
Every form has SelectFirst and SelectNext methods which according to their name allow to programmatically select a given control, or to find the next one. There is also the ActiveControl property which can be used to query which form’s control currently has the focus, or to change it.
Finally, it is worth mentioning the TScreen event OnActiveControlChange which can be used to track the changes in the control having the focus.
In an application I’m writing, I have the need to discover the taborder on any form to do some action and processing according to that tab order. I need to know the tab order without actually selecting any control. So SelectFirst and SelectNext are not useful to me. Since I couldn’t find any easy way to get the tab order, I designed some code to do it…
Getting taborder list
On a form, the controls are organized in a hierarchy. Some controls such as panels or group boxes can contain other controls. Containers can contain other containers. Each container has his own tab order. When a container receives the focus, it is either himself which receive it, or the first control inside the container. This is the container’s TabStop property which governs that behavior.
Actually each control has a TabStop property which make the control appear in the tab cycle or not. By default, containers do not have their TabStop property set while most others do.
TabOrder within a container is governed by the TabOrder property assigned to each control. The first control to receive the focus has TabOrder equal to zero. The next one has TabOrder set to one and so on. When focus has reached the last control of a container, the next adjacent control will receive the focus. The adjacent control is the one having a TabOrder equal to the container’s TabOrder plus one.
To get a list of controls ordered by TabOrder (I mean global TabOrder, considering the whole form) it is enough to traverse the controls hierarchy (It’s a tree) and sort the list by TabOrder at each level.
Traversing the control hierarchy is easy since each control has a list on contained controls. This list is the Controls[] indexed property. Only controls inheriting from TWinControl can receive focus. So the code to build the tree looks like this:
procedure TTabOrderSearchRecord.RecurseControls(
Ctrl : TWinControl);
var
I : Integer;
begin
if not Assigned(Ctrl) then
Exit;
FList.Add(Ctrl);
for I := 0 to Ctrl.ControlCount - 1 do begin
if Ctrl.Controls[I] is TWinControl then
RecurseControls(TWinControl(Ctrl.Controls[I]));
end;
end;
Not surprisingly this code is recursive. Each iteration adds a control to the list and then all contained controls recursively.
The list is not sorted by tab order! To do that sort, we must record for each control his own TabOrder as well as all the TabOrder of all of his hierarchy. You can see this TabOrder hierarchy just like a directory tree on disk: you have directories having files and subdirectories. Here we have controls containing other controls or not. Just like a file path gives the complete specification of a file in the directory hierarchy, we can build a TabOrder path as we traverse the tree.
I use a string to build the TabOrder path. At each iteration, I append the new TabOrder. A string is required because the hierarchy could be deep. There is no serious limit on the complexity of a form. I know forms having several hundred controls.
The function RecurseControls can be changed as shown below to build a list sorted by TabOrder. The trick is to add an argument to the function and append the current TabOrder to it.
procedure TTabOrderSearchRecord.RecurseControls(
Ctrl : TWinControl;
const Level : String = '');
var
I : Integer;
CI : TTabOrderItem;
begin
if not Assigned(CtrlsItems) then
CtrlsItems := TInterfacedList.Create;
if not Assigned(Ctrl) then
Exit;
CI := TTabOrderItem.Create;
CI.Ctrl := Ctrl;
CI.Level := Level;
CtrlsItems.AddItem(CI);
for I := 0 to Ctrl.ControlCount - 1 do begin
if Ctrl.Controls[I] is TWinControl then
RecurseControls(TWinControl(Ctrl.Controls[I]),
Level +
Format('%03.3d',
[TWinControl(Ctrl.Controls[I]).TabOrder + 2]));
end;
if Level = '' then
CtrlsItems.Sort(CompareTabOrderItem);
end;
This initial call remains the same, so the “Levelé argument take the default value which is the empty string. Each time the function recurse to process a container, the “Level” argument is appended the TabOrder expressed as a 3 digits number (This allow 999 controls per container which is probably enough).
At the end of the function, the level is tested to sort the list only in the case of the outer call.
Assembling the pieces
To make the code as easy to use as possible, I decided to use a record with methods instead of a class. This eliminates the need of creating an instance of the class. Before explaining how it works, let’s see how to use it.
The following code will iterate thru the list and display the name of each control:
procedure TForm1.Button1Click(Sender: TObject);
var
Ctrl : TWinControl;
SR : TTabOrderSearchRecord;
begin
Ctrl := SR.FindFirst(Self);
while Assigned(Ctrl) do begin
Display(Ctrl.Name);
Ctrl := SR.FindNext(Ctrl);
end;
SR.FindClose;
end;
As you can see, I modeled the API to looks like what we do to scan a folder for files. There is a FindFirst method, a FindNext and a FindClose. Very easy to use.
The actual list is built when invoking FindFirst method and destroyed when calling FindClose. FindClose is actually optional and only required if you want to free memory before the record goes out of scope.
Here is the complete declaration, including the class which is used for the sorted list.
TTabOrderItem = class
Ctrl : TWinControl;
Level : String;
end;
TTabOrderSearchRecord = record
public
function FindFirst(Container: TWinControl): TWinControl;
function FindNext(FromCtrl: TWinControl): TWinControl;
function FindLast(Container: TWinControl): TWinControl;
function FindPrevious(FromCtrl: TWinControl): TWinControl;
function IndexOf(Container : TWinControl;
FromCtrl : TWinControl): Integer;
procedure FindClose;
strict private
CtrlsItems : IInterfaceList;
procedure RecurseControls(Ctrl : TWinControl;
const Level : String = '');
end;
The implementation is quite simple but one thing is worth mentioning: I mean the use of an interface to hold the list. I used an interface because Delphi use automatic reference counting and will free to list as soon as it is no more used. This is very important for a record so that the list is freed when the record goes out of scope without using an explicit call.
TInterfaceList
The list is built around the simple TList and makes use of generics so that it can be reuse for many things. I used composition instead of inheritance to expose the minimal interface I wanted.
The interface itself is defined as an interface, again using generics to make it reusable.
IInterfaceList= interface(IInterface)
function Item(Index : Integer) : T;
function AddItem(Ctrl : T) : Integer;
function IndexOf(Ctrl : T) : Integer;
function ItemCount : Integer;
procedure Sort(Compare: TCompareFunction);
end;
Since it is an interface, there is no direct implementation. The actual implementation is defined in a class. I derived the class from TInterfacedObject to get reference counting required for hosting an interface.
TInterfacedList = class(TInterfacedObject, IInterfaceList)
strict private
FList : TList;
public
constructor Create;
destructor Destroy; override;
function Item(Index : Integer) : T;
function AddItem(Ctrl : T) : Integer;
function IndexOf(Ctrl : T) : Integer;
function ItemCount : Integer;
procedure Sort(Compare: TCompareFunction);
end;
There is a constraint in the type used as a variable: it is limited to a class. This is required because the implementation uses some typecast which are only valid when the type is a class.
The sort method requires a comparison function so that it works whatever the type is.
TCompareFunction = function (Item1, Item2 : T) : Integer;
Complete implementation
function CompareTabOrderItem(Item1, Item2: TTabOrderItem): Integer;
begin
if Item1.Level = Item2.Level then
Result := 0
else if Item1.Level < Item2.Level then
Result := -1
else
Result := 1;
end;
procedure TTabOrderSearchRecord.RecurseControls(
Ctrl : TWinControl;
const Level : String = '');
var
I : Integer;
CI : TTabOrderItem;
begin
if not Assigned(CtrlsItems) then
CtrlsItems := TInterfacedList.Create;
if not Assigned(Ctrl) then
Exit;
CI := TTabOrderItem.Create;
CI.Ctrl := Ctrl;
CI.Level := Level;
CtrlsItems.AddItem(CI);
for I := 0 to Ctrl.ControlCount - 1 do begin
if Ctrl.Controls[I] is TWinControl then
RecurseControls(TWinControl(Ctrl.Controls[I]),
Level +
Format('%03.3d',
[TWinControl(Ctrl.Controls[I]).TabOrder + 2]));
end;
if Level = '' then
CtrlsItems.Sort(CompareTabOrderItem);
end;
procedure TTabOrderSearchRecord.FindClose;
begin
CtrlsItems := nil;
end;
function TTabOrderSearchRecord.FindFirst(Container: TWinControl): TWinControl;
var
I : Integer;
begin
//CtrlsItems := TInterfacedList.Create;
RecurseControls(Container);
I := -1;
repeat
Inc(I);
until (I >= CtrlsItems.ItemCount) or
(CtrlsItems.Item(I).Ctrl.CanFocus and
CtrlsItems.Item(I).Ctrl.TabStop);
if I >= CtrlsItems.ItemCount then
Result := nil
else
Result := CtrlsItems.Item(I).Ctrl;
end;
function TTabOrderSearchRecord.FindLast(Container: TWinControl): TWinControl;
var
I : Integer;
begin
//CtrlsItems := TInterfacedList.Create;
RecurseControls(Container);
I := CtrlsItems.ItemCount;
repeat
Dec(I);
until (I < 0) or
(CtrlsItems.Item(I).Ctrl.CanFocus and
CtrlsItems.Item(I).Ctrl.TabStop);
if I < 0 then
Result := nil
else
Result := CtrlsItems.Item(I).Ctrl;
end;
function TTabOrderSearchRecord.FindNext(FromCtrl: TWinControl): TWinControl;
var
I : Integer;
begin
Result := nil;
if CtrlsItems = nil then
Exit;
I := 0;
while I < CtrlsItems.ItemCount do begin
if CtrlsItems.Item(I).Ctrl = FromCtrl then begin
repeat
Inc(I);
until (I >= CtrlsItems.ItemCount) or
(CtrlsItems.Item(I).Ctrl.CanFocus and
CtrlsItems.Item(I).Ctrl.TabStop);
if I >= CtrlsItems.ItemCount then
Result := nil
else
Result := CtrlsItems.Item(I).Ctrl;
Exit;
end;
Inc(I);
end;
end;
function TTabOrderSearchRecord.FindPrevious(FromCtrl: TWinControl): TWinControl;
var
I : Integer;
begin
Result := nil;
if CtrlsItems = nil then
Exit;
I := 0;
while I < CtrlsItems.ItemCount do begin
if CtrlsItems.Item(I).Ctrl = FromCtrl then begin
repeat
Dec(I);
until (I < 0) or
(CtrlsItems.Item(I).Ctrl.CanFocus and
CtrlsItems.Item(I).Ctrl.TabStop);
if I < 0 then
Result := nil
else
Result := CtrlsItems.Item(I).Ctrl;
Exit;
end;
Inc(I);
end;
end;
function TTabOrderSearchRecord.IndexOf(
Container : TWinControl;
FromCtrl : TWinControl): Integer;
var
Ctrl : TWinControl;
begin
//CtrlsItems := TInterfacedList.Create;
Result := 0;
Ctrl := FindFirst(Container);
while Assigned(Ctrl) do begin
if Ctrl = FromCtrl then
Exit;
Ctrl := FindNext(Ctrl);
Inc(Result);
end;
Result := -1;
end;
{ TInterfacedList }
function TInterfacedList.AddItem(Ctrl: T): Integer;
begin
if not Assigned(FList) then
raise Exception.Create('TInterfacedList.AddItem failed: ' +
'list not assigned');
Result := FList.Add(Pointer(Ctrl));
end;
constructor TInterfacedList.Create;
begin
inherited Create;
FList := TList.Create;
end;
destructor TInterfacedList.Destroy;
begin
FreeAndNil(FList);
inherited;
end;
function TInterfacedList.IndexOf(Ctrl: T): Integer;
begin
if not Assigned(FList) then
Result := -1
else
Result := FList.IndexOf(Pointer(Ctrl));
end;
function TInterfacedList.Item(Index: Integer): T;
begin
if (not Assigned(FList)) or (FList.Count <= 0) then
Result := nil
else
Result := T(FList[Index]);
end;
function TInterfacedList.ItemCount: Integer;
begin
if not Assigned(FList) then
Result := 0
else
Result := FList.Count;
end;
procedure TInterfacedList.Sort(Compare: TCompareFunction );
var
I, J : Integer;
Temp : TWinControl;
begin
// TList has a quicksort method, but it is bugged in some versions
// FList.Sort(Compare);
// So we use the good old bubble sort, anyway the list is small
for J := 0 to FList.Count - 2 do begin
for I := J to FList.Count - 1 do begin
if Compare(FList.Items[J], FList.Items[I]) > 0 then begin
Temp := FList[J];
FList[J] := FList[I];
FList[I] := Temp;
end;
end;
end;
end;
Demo program and source code
I made a zip file available with the full source code, including a simple demo application showing how to use it. You can download it from http://www.overbyte.be/frame_index.html?redirTo=/blog_source_code.html
Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
This article is available from http://francois-piette.blogspot.be/2013/04/taborder blues.html
April 6, 2013
Subclassing a window
What is it?
Subclassing a window is the process of intercepting all calls to the window procedure of a given window. When you subclass a window, you can get hand on every message sent/posted to the window you’ve subclassed.
Why subclass?
Why would you want to subclass a window ? For example if a windows does almost everything you want, but you need a few more features, you can change or add features to the original control by subclassing it.
I my case, I had the need from another window to know when a specific window was disabled and enabled again. This is easy to do using subclassing because when a window is enabled or disabled, it receives a WM_ENABLE message. Al I had to do was to subclass the target window, check for WM_ENABLE message to do what I have to do and pass long everything to the original window procedure.
My real application is a little bit complex to explain. This is why in this article I will show you how to do using a very simple demo program. A Delphi form will subclass itself to trap the WM_ENABLE message. Using the exact same technic, you can subclass any window, being a form or a control or even a non-Delphi window.
How to subclass?
Every window has a so called “window procedure”. This is a procedure that window call whenever a message has to be processed by the window. For example, when a window needs to be painted, Windows send WM_PAINT message. When you move the mouse over the window, Windows send WM_MOUSEMOVE and so on.
The window procedure is fixed when creating the window. For an existing window, you can get or set the window procedure using Windows API function GetWindowLong and SetWindowLong using the constant GWL_WNDPROC to specify what to get or set.
// Get the existing window procedure (his address)
FWndProcPrevious := TFNWndProc(GetWindowLong(Handle, GWL_WNDPROC));
// Set back the saved window procedure
SetWindowlong(Handle, GWL_WNDPROC, NativeInt(FWndProcPrevious));
To set a new window procedure, you must first create that procedure in your code. Using Delphi, you add the following declaration in your form:
procedure WndProcSubClassed(var Msg: TMessage);
An example implementation trapping WM_ENABLE message would be:
procedure TForm1.WndProcSubClassed(var Msg: TMessage);
begin
if Msg.Msg = WM_ENABLE then
Memo1.Lines.Add('WM_ENABLE ' + IntToStr(Ord(TWMEnable(Msg).Enabled)));
Msg.Result := CallWindowProc(FWndProcPrevious, Handle, Msg.Msg, Msg.WParam, Msg.LParam);
end;
In this implementation, a call if made to CallWindowProc to pass along everything to the original window procedure.
We cannot pass WndProcSubClassed directly to SetWindowLong because it is not a simple procedure but a method of object which is not exactly the same. Windows API doesn’t know at all Delphi objects!
Delphi runtime has a function called MakeObjectInstance which does the required work to stub an object method and return a simple procedure suitable for Windows API. Since MakeObjectInstance allocate memory on the fly, it must be freed later by calling FreeObjectInstance.
Know those details; we can now create two procedures to subclass and unsubclass a given window:
procedure TForm1.SubClass;
begin
if FWndProcPrevious <> nil then
ShowMessage('Already subclassed')
else begin
FWndProcPrevious := TFNWndProc(GetWindowLong(Handle, GWL_WNDPROC));
FWndProcInstanceStub := MakeObjectInstance(WndProcSubClassed);
SetWindowlong(Handle, GWL_WNDPROC, NativeInt(FWndProcInstanceStub));
end;
end;
procedure TForm1.UnsubClass;
begin
if FWndProcPrevious <> nil then begin
SetWindowlong(Handle, GWL_WNDPROC, NativeInt(FWndProcPrevious));
FreeObjectInstance(FWndProcInstanceStub);
FWndProcPrevious := nil;
FWndProcInstanceStub := nil;
end;
end;
You can call SubClass from the FormShow event handler, or from a button click or whatever fits your needs. Don’t forget to call UnsubClass whenever you don’t need subclassing anymore, for example from a button OnClick handler or simply from FormDestroy.
The demo I wrote (see complete code below) applies this. There I a form with 3 buttons and a memo. Two buttons are used for subclassing and unsubclassing the form. The third button is used to call ShowMessage which is modal and as such disable the window, making a WM_ENABLE message to be sent before and after the modal dialog box is show. The demo display this is the memo.
Complete demo
Here is the source code:unit SubClassingMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
SubClassButton: TButton;
Memo1: TMemo;
UnsubClassButton: TButton;
Button3: TButton;
procedure SubClassButtonClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure UnsubClassButtonClick(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
FWndProcPrevious : TFNWndProc;
FWndProcInstanceStub : Pointer;
procedure WndProcSubClassed(var Msg: TMessage);
procedure UnsubClass;
procedure SubClass;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.SubClassButtonClick(Sender: TObject);
begin
SubClass;
end;
procedure TForm1.UnsubClassButtonClick(Sender: TObject);
begin
UnsubClass;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
ShowMessage('Hello');
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnsubClass;
end;
procedure TForm1.SubClass;
begin
if FWndProcPrevious <> nil then
ShowMessage('Already subclassed')
else begin
FWndProcPrevious := TFNWndProc(GetWindowLong(Handle, GWL_WNDPROC));
FWndProcInstanceStub := MakeObjectInstance(WndProcSubClassed);
SetWindowlong(Handle, GWL_WNDPROC, NativeInt(FWndProcInstanceStub));
end;
end;
procedure TForm1.UnsubClass;
begin
if FWndProcPrevious <> nil then begin
SetWindowlong(Handle, GWL_WNDPROC, NativeInt(FWndProcPrevious));
FreeObjectInstance(FWndProcInstanceStub);
FWndProcPrevious := nil;
FWndProcInstanceStub := nil;
end;
end;
procedure TForm1.WndProcSubClassed(var Msg: TMessage);
begin
if Msg.Msg = WM_ENABLE then
Memo1.Lines.Add('WM_ENABLE ' + IntToStr(Ord(TWMEnable(Msg).Enabled)));
Msg.Result := CallWindowProc(FWndProcPrevious, Handle, Msg.Msg, Msg.WParam, Msg.LParam);
end;
end.
Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
This article is available from http://francois-piette.blogspot.be/2013/03/subclassing-a-window.html
April 3, 2013
Inter Process Communication Using Pipes
A pipe is a communication channel between two ends. It is mostly used to communicate between processes running within a computer. As such it is an Inter Process Communication (IPC) mechanism.
The concept of pipe is well known in the Linux (Unix) world. It is used on the command line to direct the output of a command as input of the next command. The so called “pipe character” is used as a syntax gadget for that purpose. Windows is using the same syntax.
More generally, a pipe is an operating system object which is close to a file. An application opens a pipe, then read and writes data and finally closes it. The difference between a pipe and a file is that data is kept in memory and the pipe has two ends. The same or different processes may open the same pipe. What is written at one end becomes readable at the other end. This is why it is named a “pipe”: it fact as a pipe or tunnel between the two ends, data flows from one end and the other. Unlike pipes in the real world, computer pipes are bi-directional. One computer pipe is actually made of two distinct sub-pipes: one for each direction.
We can think of pipes as client/server architecture. The server side opens a pipe and waits for data to be available. The client side opens the pipe and then data may flow into the pipe in both directions independently. If several clients open the same pipe, the server sees it as several independent pipes. At server side, data may be written to individual client’s pipes or broadcasted to all clients.
As seen from Windows API, a pipe can be created with or without a name. Giving a name to a pipe allows processes to share the same pipe easily. When using anonymous pipes, a process knows about it because it has inherited his handle.
The process that creates a pipe is the pipe server. A process that connects to a pipe is a pipe client. One process writes data to the pipe, and then the other process reads the data from the pipe. This is bidirectional: each process can write data that will be read by the other. Read and writes are asynchronous. It means a lot of data may be written before it is read at the other end. Data is stored by the operating system into shared memory. The size of the shared memory area is managed by the operating system using advisory values passed to the pipe’s creation function.
Windows pipe API is relatively complex. It has been encapsulated into Delphi classes by Russell Libby in 2003. Although Russell website is no more available, his code is still around in the internet and has been enhanced by several peoples. I have updated his code for Delphi XE3 and made it available from my website at http://www.overbyte.be/eng/blog_source_code.html
Russell wrote a unit named “pipes.pas” containing 3 components:
- TPipeClient: client component
- TPipeServer: Server component
- TPipConsole: console pipe redirection component
For your convenience, I created two packages: one runtime package and one design time package. The components are installed in the component palette under “Pipes” tab.
Using the components is fairly simple. I made two simple demo programs: PipeClient and PipeServer. You run PipeServer first and then one or more PipeClient instances. PipeClient has an edit box and a “Send” button. When you click on “Send”, the edit box content is sent to the server which in turn displays it in a memo. At server side, the “send” button is replaced by “broadcast” to send the same message to all connected client, if any. Of course you may also send to a specific client.
To send the messages, I actually send strings, taking care of Unicode. When sending (Write or broadcast method), you have to pass a pointer to the first byte to be sent and a count of bytes. At receiver side, data is read from a stream which is also made of bytes.
Warning: a pipe is a byte oriented communication channel. There is no guarantee that each single write at one end will correspond to a single read at the other end. Sending strings has I’ve done in my demo is good for interactive application where a user clicks on a button. In a real world application, you have to design a protocol, just like you do when using socket, so that the reader knows exactly what the writer sent. For example, you send a message made of a byte count and the then actual bytes. Or you design a “line oriented” protocol much like most TCP/IP protocol are. Your messages are made you line of text terminated by a CRLF pair. The reader knows he received a complete message because he received the CRLF pair.
To say it in other words, a pipe is like a TFileStream. The read doesn’t know how the stream has been written. He knows how to read it, for example he knows the stream is made of text lines.
UPDATE 2013-10-04: arno.garrels@gmx.de added 64-bit support and fixed code to compile with Delphi 7 to XE5 (earlier versions may compile however untested).
Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
This article is available from http://francois-piette.blogspot.be
Download source code from my website at
http://www.overbyte.be/eng/blog_source_code.html
The concept of pipe is well known in the Linux (Unix) world. It is used on the command line to direct the output of a command as input of the next command. The so called “pipe character” is used as a syntax gadget for that purpose. Windows is using the same syntax.
More generally, a pipe is an operating system object which is close to a file. An application opens a pipe, then read and writes data and finally closes it. The difference between a pipe and a file is that data is kept in memory and the pipe has two ends. The same or different processes may open the same pipe. What is written at one end becomes readable at the other end. This is why it is named a “pipe”: it fact as a pipe or tunnel between the two ends, data flows from one end and the other. Unlike pipes in the real world, computer pipes are bi-directional. One computer pipe is actually made of two distinct sub-pipes: one for each direction.
We can think of pipes as client/server architecture. The server side opens a pipe and waits for data to be available. The client side opens the pipe and then data may flow into the pipe in both directions independently. If several clients open the same pipe, the server sees it as several independent pipes. At server side, data may be written to individual client’s pipes or broadcasted to all clients.
As seen from Windows API, a pipe can be created with or without a name. Giving a name to a pipe allows processes to share the same pipe easily. When using anonymous pipes, a process knows about it because it has inherited his handle.
The process that creates a pipe is the pipe server. A process that connects to a pipe is a pipe client. One process writes data to the pipe, and then the other process reads the data from the pipe. This is bidirectional: each process can write data that will be read by the other. Read and writes are asynchronous. It means a lot of data may be written before it is read at the other end. Data is stored by the operating system into shared memory. The size of the shared memory area is managed by the operating system using advisory values passed to the pipe’s creation function.
Windows pipe API is relatively complex. It has been encapsulated into Delphi classes by Russell Libby in 2003. Although Russell website is no more available, his code is still around in the internet and has been enhanced by several peoples. I have updated his code for Delphi XE3 and made it available from my website at http://www.overbyte.be/eng/blog_source_code.html
Russell wrote a unit named “pipes.pas” containing 3 components:
- TPipeClient: client component
- TPipeServer: Server component
- TPipConsole: console pipe redirection component
For your convenience, I created two packages: one runtime package and one design time package. The components are installed in the component palette under “Pipes” tab.
Using the components is fairly simple. I made two simple demo programs: PipeClient and PipeServer. You run PipeServer first and then one or more PipeClient instances. PipeClient has an edit box and a “Send” button. When you click on “Send”, the edit box content is sent to the server which in turn displays it in a memo. At server side, the “send” button is replaced by “broadcast” to send the same message to all connected client, if any. Of course you may also send to a specific client.
To send the messages, I actually send strings, taking care of Unicode. When sending (Write or broadcast method), you have to pass a pointer to the first byte to be sent and a count of bytes. At receiver side, data is read from a stream which is also made of bytes.
Warning: a pipe is a byte oriented communication channel. There is no guarantee that each single write at one end will correspond to a single read at the other end. Sending strings has I’ve done in my demo is good for interactive application where a user clicks on a button. In a real world application, you have to design a protocol, just like you do when using socket, so that the reader knows exactly what the writer sent. For example, you send a message made of a byte count and the then actual bytes. Or you design a “line oriented” protocol much like most TCP/IP protocol are. Your messages are made you line of text terminated by a CRLF pair. The reader knows he received a complete message because he received the CRLF pair.
To say it in other words, a pipe is like a TFileStream. The read doesn’t know how the stream has been written. He knows how to read it, for example he knows the stream is made of text lines.
UPDATE 2013-10-04: arno.garrels@gmx.de added 64-bit support and fixed code to compile with Delphi 7 to XE5 (earlier versions may compile however untested).
Follow me on Twitter
Follow me on LinkedIn
Follow me on Google+
Visit my website: http://www.overbyte.be
This article is available from http://francois-piette.blogspot.be
Download source code from my website at
http://www.overbyte.be/eng/blog_source_code.html
Subscribe to:
Posts (Atom)