How to avoid flicker when moving or sizing a MDI child form

Problem/Question/Abstract:

I have an MDI application with many child forms. Their windowstate property is set to maximized. When a child form is created and shown, the form visibly resizes as it is shown. I would like the child form to open already maximized without the visible resizing. Any ideas?

Answer:

Preventing visible flicker when moving or sizing MDI children directly after their creation:

{ ... }
public
{ Public declarations }

constructor Create(aOwner: TComponent); override;
end;

implementation

{$R *.DFM}

constructor TMDIChild.Create(aOwner: TComponent);
var
  crect: TRect;
  chandle: HWND;
begin
  { Get handle of MDI client window }
  chandle := application.mainform.clienthandle;
  { Block redrawing of this window and its children }
  Lockwindowupdate(chandle);
  { Create this MDI child at default position, it will not be drawn yet
        due to the update block }
  inherited Create(aOwner);
  { Get the client windows rect and center this form in it }
  Windows.GetClientrect(chandle, crect);
  SetBounds((crect.right - width) div 2, (crect.bottom - height) div 2, width,
    height);
  { Release the block, this allows the form to redraw at the new position }
  LockWindowUpdate(0);
end;

Enumerating user tables in an InterBase database

Problem/Question/Abstract:

Enumerating user tables in an InterBase database

Answer:

A list of user tables can be retrieved by querying system table rdb$relations.

The example below shows how to do this - it inserts the table names sorted alphabetically into a ListBox (lbSourceTables).

begin
  ibcSourceList.SQL.Clear;
  ibcSourceList.SQL.Add('select rdb$relation_name from rdb$relations');
  ibcSourceList.SQL.Add('where rdb$system_flag = 0');
  ibcSourceList.SQL.Add('order by rdb$relation_name');
  ibcSourceList.Open;
  while not ibcSourceList.Eof do
  begin
    lbSourceTables.Items.Add(ibcSourceList.Fields[0].AsString);
    ibcSourceList.Next;
  end;
  ibcSourceList.Close;
end;

Determining if there is a disk/diskette/CD in a removable-disk drive

Problem/Question/Abstract:

How can I know if there is a CD in the CD drive?

Answer:

The trick is done by calling the API GetDiskFreeSpace and returning its return value as a boolean. The following function takes the drive letter as a parameter (for example 'A', 'D', etc.) and returns True if there is a disk in the drive, or False if not.

var
  DrivePath: array[0..3] of char = 'A:\';

function IsDiskIn(drive: char): boolean;
var
  d1, d2, d3, d4: longword;
begin
  DrivePath[0] := drive;
  Result := GetDiskFreeSpace(DrivePath, d1, d2, d3, d4);
end;

In the implementation we use an initialized null-terminated string (DrivePath) that contains the root directory of drive A: and we substitute the drive letter with the one passed as parameter before calling GetDiskFreeSpace.

Sample call

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not IsDiskIn('A') then
    ShowMessage('Drive A: Not Ready');
end;

Copyright (c) 2001 Ernesto De Spirito
Visit: http://www.latiumsoftware.com/delphi-newsletter.php

Define a border for your TMemo field

Problem/Question/Abstract:

Define a border for your TMemo field

Answer:

The following snippet defines a left border of a width of 20 pixels:

var
  Rect: TRect;
begin
  SendMessage(Memo1.Handle, EM_GETRECT, 0, LongInt(@Rect));
  Rect.Left := 20;
  SendMessage(Memo1.Handle, EM_SETRECT, 0, LongInt(@Rect));
  Memo1.Refresh;
end;

Inside Delphi's Classes and Interfaces Part I

Problem/Question/Abstract:

You've probably used classes & interfaces more than once in your delphi programs. Did you ever dtop to think how delphi implements this creatures ?

Answer:

A few words before we start :

First, I want to start this article by saying that all of the knowledge in this paper is derived from viewing the disassembler of Delphi5. Hence everything writen here is valid only for Delphi5 and might change by any upgrade / different version.
Second, inorder to fully understand what is writen in this article, you'll have to dive into some assembler code. I'll explain what the assembler code does, but be prepared, it might get messy.

And now to the real stuff. In delphi a class' instance is a simple pointer. That might seem odd to some people, since you've used instances in delphi many a time, and never had to treat them like pointers. That is correct, but only because boralnd was kind enough to wrap these pointers nicly up.
These pointers actually point to a complicated structor in memory, which we'll try and understand. First we'll look at some simple class' defenition :

TBoo1 = class
  FDataA, FDataB: Integer;
end;

var
  Boo1: TBoo1;
begin
  Boo1 := TBoo1.Create;
end;

Now let's look at what Boo1 points to (Boo1 is a pointer, remember ?) :

(Boo1 points to the following values, each 4 bytes long)
a Pointer to TBoo1's VMT
FDataA
FDataB

Now let's examine a decendant of TBoo1 :

TBoo2 = class(TBoo1)
  FDataC, FDataD: Integer;
end;

var
  Boo2: TBoo2;
begin
  Boo2 := TBoo2.Create;
end;

Boo2 will point to the following values in memory :
a Pointer to TBoo2's VMT
FDataA
FDataB
FDataC
FDataD

Notice that the values that Boo2 points to include some of the values that Boo1 points to. That's very easy to explain - TBoo2 inherites from TBoo1, therefor it must include all of the fields that TBoo1 has.

As a general case, we could state that each class instance points to the following values :

a pointer to the Class' VMT
a list of the Class' parent's fields
a list of the Class' fields

Now it's time to investigate interfaces. Before we can fully understand interfaces we must understand the way delphi makes a method call to a class' instance. What delphi actually does, is call a function with one more parameter than was declared, and that parameter is the instance itself. Let's look at an example :

TMoo = class
  FData: Integer;
  procedure Act(Value: Integer);
end;

procedure TMoo.Act(Value: Integer);
begin
  if FData = Value then
    FData := FData + 1
  else
    FData := Value;
end;

var
  Moo: TMoo;
begin
  Moo := TMoo.Create;
  Moo.Act(15);
end;

How does delphi implement this ? Simple, 'TMoo.Act' is actually compiled into a procedure that accepts two(!) parameters. One is the defined parameter -'Value' of type integer. The other is an instance of class TMoo. Every time delphi calls 'Moo.Act' it does some preprocessing before hand, that is, it passes the instance of TMoo that is making the call. Basically you could say that any call to a method of an object is translated to a regular call to a function / procedure that accepts the object making the call as a parameter.
In the previos example, 'TMoo.Act' is actually compiled to something like this :

procedure TMoo_Act(Self: TMoo; Value: Integer);
begin
  if Self.FData = Value then
    Self.FData := FData + 1
  else
    Self.FData := Value;
end;
  
It's time to go back to interfaces. Consider the following code :

IKoo = interface
  function Calculate(Value: Integer): Double;
end;

function Evaluate(Koo: IKoo; Value: Integer): Double;
begin
  Result := Koo.Calculate(Value);
end;

TKooA = class(TInterfacedObject, IKoo)
  function Calculate(Value: Integer): Double;
end;

TKooB = class(TInterfacedObject, IKoo)
  procedure DoNothing;
  function Calculate(Value: Integer): Double;
end;

Any class that supports IKoo can be passed as a variable to the function 'Evaluate'. When we pass an instance of TKooA to 'Evaluate' we need to call the first method of TKooA, but when we pass an instance of TKooB, we need to call the second method of TKooB ! How will delphi now which function to call at each time ?!

Inorder to understand the answer, we must review what an interface realy is (and how it is implemented in delphi). An interface is simply a list of methods that a class declares that it implements. That is, each method in the interface is implemented in the class. The way deplhi implements this is thus :

Each interface a class supports is actually a list of pointers to methods. Therefor, each time a method call is made to an interface, the interface actually diverts that call to one of it's pointers to method, thus giving the object that realy imlpements it the chance to act. I'll explain that via the 'Koo' example above :

Each time the function 'Evaluate' gets a parameter of type IKoo, it realy gets a list (with 4 items - IKoo inherites from IUnknown) of pointers to methods. If it got an IKoo interface that was implemented by TKooA, then the 4th item in the pointer-to-method list would point to  'TKooA.Calcualte'. Otherwise it would point to 'TKooB.Calcualte'. Therefor, when a call is made to 'IKoo.Calculate' what actually is called is what 'IKoo.Calcualte' points to (either 'TKooA.Calculate' or TKooB.Calculate'). Thus delphi implements interfaces.

And now to how delphi stores interfaces in memory. For each instance of a class that supports 'N' interfaces, we need 'N' different lists of pointer-to-method (for each interface we need a list of pointer-to-method). But these lists are the same in the scope of a single class, therefor inorder to save memory, we only hold 'N' pointers to these lists for each instance (instead of the lists themselves).

Consider the following code :

ILooA = interface
end;

ILooB = interface
end;

TLoo = class(TInterfacedObject, ILooA, ILooB)
  FLooA, FLooB: Integer;
end;

This is how an instance of TLoo would look in memory :

a pointer to TLoo's VMT
FRefcount
IUnknown
FLooA
FLooB
ILooB
ILooA

In general, any class' instance would look like this :

a poitner to the class' VMT
the class' parent's structor (except for the pointer to the VMT)
first data member of the class
.
.
last data member of the class
last interface in the class' interface list
.
.
first interface in the class' interface list

As I said at the begining of this article, inorder to realy grasp the way delphi implements class & interfaces we must look at the assembler code delphi produces.
First we'll learn a bit of assembler inorder to understand to code that will follow. In assembler there is a thing called 'Register'. A register is a place on the CPU that can hold a 32 bit value. On a Pentium CPU there are 8 main registers (EAX, EBX, ECX, EDX, ESI, EDI, EBP, ESP). Most actions that are done in assembler are done on registers. Here are a few commands in assembler :

(Moves the value into the register)
MOV Register, Value

(Moves the value in Register2 into Register1)
Mov Register1, Register2

(Moves the value that Register2 points to into Register1. This is the same as the followin code : 'Register1 := Register2^;')
Mov Register1, [Register2]

(Moves the value that Register2 + Value points to into Register1. The same as :
'Register1 := Pointer(Integer(Register2) + Value)^;')
Mov Register1, [Register2 + Value]
  
Eaxmples :

Mov EAX, 10
MOV EBX, EAX
MOV EAX, [EBX + 6]

EBX will hold the value 10 and EAX will hold the value that is in the address $10.

  Just inorder to make sure that you understood this part, I'll give an example of how delphi assignes a value to an instance's data member.

TGoo = class
  FDataA, FDataB: Integer;
end;

var
  Goo: TGoo;
begin
  Goo := TGoo.Create;
  Goo.FDataA := 5;
  Goo.FDataB := 7;
end;

If you'd open delphi's disassembler you'd see the following code :

//Goo.FDataA := 5;
mov eax, [ebp - $08]
mov[eax + $04], $00000005
//Goo.FDataB := 7;
mov eax, [ebp - $08]
mov[eax + $08], $00000007

Why move the value pointed by 'ebp-$08' ? Simple, that's where the variable Goo is stored. Notice that accessing FDataA is the same as accessing the address at 'eax + $04' and that accessing FDataB is the same as accessing the address at 'eax + $08'. That's because the address 'eax' points to is the pointer to the VMT of TGoo, and (as I mentioned before) the following values in memory are the data members of TGoo.

Let's go back to interfaces. Look at the following code :

IRoo = interface
end;

TRoo = class(TInterfacedObject, IRoo)
end;

var
  Roo: TRoo;
  RooIntf: IRoo;
begin
  Roo := TRoo.Create;
  RooIntf := Roo;
  RooIntf._AddRef;
end;

The following assembler code isn't exactly what delphi produces but it serves the same point :

// RooIntf := Roo;
// eax holds the value returned by TRoo.Create, that is, the variable Roo
// ecx holds the value that should later be assigned to RooIntf
mov ecx, eax
// This is the same as : 'ecx := ecx + $0C';
add ecx, $0C
// RooIntf._AddRef
// Push 'ecx' onto the CPU's stack
push ecx
mov ecx, [ecx]
// 'call' tells the CPU to jump to the address stored as a value in 'ecx'
call ecx

Let's look at the code that 'call ecx' brought us too :

// POP the value we pushed onto the stack into 'ecx'
pop ecx
// Same as : 'ecx := ecx - $0c;
sub ecx, $0C
// Call the method '_AddRef' with 'ecx' as a variable.
call TInterfacedObject._AddRef(ecx)

A Little explaination is due. Why did delphi add '$0C' to 'ecx' ? remember how Roo is stored in memory (a pointer to VMT, FRefCount (Of InterfacedObject), IUnknown (Of TInterfacedObject), IRoo). IRoo is the forth value in the list that 'ecx' points to. Each value is 4 bytes long, so IRoo is 12 (4*4) bytes after 'ecx', and '$0C' is 12 in exadecimel notation. So basically, adding '$0C' to 'ecx' just made 'ecx' point to the right value, that is, point to IRoo of Roo (an instance of TRoo).
  
Why do we push ecx into the stack ? That's cause we'll need to use it later, when calling the real '_AddRef' method. Remeber, 'ecx' is the value pointing to Roo + 12.
After that, we move into 'ecx' the value that 'ecx' pointed to. Remeber when I said that instead of holding the lists of pointer-to-method, delphi stores only the pointers to them (to save memory) ? That's why 'ecx' was actually a pointer, but now it holds the value it pointed to before.

  The next command, is to call the method that 'ecx' holds. Now we'll look at that method. It's very short. The only thing it does is modify the value of 'ecx' (after poping it from the stack) so it is equal to the value of Roo (that is, it points to the variable Roo). Then the method 'TInterfacedObject._AddRef' is called with 'ecx' (Roo) as a parameter. This is the same as when I've writen that delphi actually complies a Class' method into a regualr function / procedure that accepts one extra parameter - the instance of the class.
  What was that good for ? We added a value from a poitner then did this jump around in memory, then subtracted the same value from the pointer and called the function the pointer points too ! why bother ? we could simple call the function without adding and subtracting values !
  
  This is where the power of indirection comes into the game. Notice
that the call to 'RooIntf._AddRef' didn't know that RooIntf was actually of an instance of TRoo. It just called the method that was there to call. The Implementation of this method is where the reassigning of the value of the pointer was made. That is, only the implementation that RooIntf points to (IRoo of TRoo) knew how much was added or substracted from the pointer pushed to the stack. If we had another varaible of type TRoo2, that also implemented IRoo, and we would have made the following assignment 'RooIntf := varaible of type TRoo2', and would call the method 'RooIntf._AddRef' then a different value would be subtracted from the value in the stack. Thus making the method call go to the right place in the TRoo2 class.

How to trap mouse clicks on the Desktop when using a system wide mouse hook

Problem/Question/Abstract:

Does anyone know how to tell (in Delphi code) if I have clicked on the Desktop (not an icon). I have written a system wide mouse hook program but the window handle and the icon handle are the same. How can I tell the difference?

Answer:

I did this by creating a DLL (you can only hook into the desktop via a DLL). The DLL then posts messages to the main application. You need to load the DLL, call Initialize supplying the applications handle (note: StdCall). You then need to assign a custom message handler (application.OnMessage) to listen for the messages posted from the DLL.

Here is the application message handler:

const
  WM_DESKTOPMOUSEMESSAGE = WM_USER + 1;

procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  case Msg of
    WM_DESKTOPMOUSEMESSAGE:
      case Msg.WParam of
        WM_LBUTTONUP: ShowMessage('You clicked on the desktop');
      end;
  end;

procedure TForm1.OnCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage;
end;


Here is the hook code:


Important note about DLL memory management: ShareMem must be the first unit in your library's USES clause AND your project's (select Project-View Source) USES clause if your DLL exports any procedures or functions that pass strings as parameters or function results. This applies to all strings passed to and from your DLL - even those that are nested in records and classes. ShareMem is the interface unit to the BORLNDMM.DLL shared memory manager, which must be deployed along with your DLL. To avoid using BORLNDMM.DLL, pass string information using PChar or ShortString parameters.

library test;

uses
  SysUtils, Messages, Windows;

{$R *.RES}

const
  WM_DESKTOPMOUSEMESSAGE = WM_USER + 1;

var
  HookHandle: HHook;
  DesktopHandle: HWnd;
  AppHandle: HWnd;

procedure log(logstr: string);
var
  F1: Textfile;
begin
  AssignFile(F1, 'c:\temp.log');
  if FileExists('c:\temp.log') then
    Append(F1)
  else
    Rewrite(F1);
  writeln(F1, logstr);
  CloseFile(F1);
end;

function MouseHook(code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;
var
  WinDir: array[0..MAX_PATH] of Char;
  f: file of HWnd;
begin
  {This only happens once, we use the file just to get the variable across to the systems memory}
  if AppHandle = 0 then
  begin
    GetWindowsDirectory(Windir, MAX_PATH);
    AssignFile(f, WinDir + '\ah.dat');
    Reset(f);
    Read(f, AppHandle);
    CloseFile(f);
  end;
  PostMessage(AppHandle, WM_DESKTOPMOUSEMESSAGE, wParam, lParam);
  Result := CallNextHookEx(HookHandle, Code, WParam, LParam);
end;

procedure Initialize(ApplicationHandle: HWnd); stdcall;
var
  res, pid: DWORD;
  f: file of HWnd;
  WinDir: array[0..MAX_PATH] of Char;
begin
  {Write the application handle to a file so that it can be read first time round
        by the hook (the hook has its own memory space)}
  Fillchar(windir, sizeOf(WinDir), 0);
  GetWindowsDirectory(Windir, MAX_PATH);
  AssignFile(f, WinDir + '\ah.dat');
  Rewrite(f);
  Write(f, ApplicationHandle);
  CloseFile(f);
  DesktopHandle := FindWindow(nil, 'Program Manager');
  if DesktopHandle = 0 then
    HookHandle := 0
  else
  begin
    AppHandle := ApplicationHandle;
    res := GetWindowThreadProcessID(DesktopHandle, @pid);
    HookHandle := SetWindowsHookEx(WH_MOUSE, @MouseHook, hInstance, res);
  end;
end;

procedure DeInitialize; stdcall;
begin
  if HookHandle <> 0 then
    UnHookWindowsHookEx(HookHandle);
end;

exports
  Initialize,
  DeInitialize;

begin
end.

Adding a Master Password to a Paradox Table

Problem/Question/Abstract:

How do I add a password to a Paradox table using nothing but code?

Answer:

It is said that necessity is the mother of invention. And I've found that saying to ring true time and time again. With respect to the subject at hand, I didn't need to know how to do this until I actually had to do it with a program that I needed to write.

But before I started out, I did the usual thing by asking myself some questions:

Is there a method in an existing component (for our purposes TTable) that can do this? Why reinvent the wheel?
If not, is there any resource available that might be able to do this? Again, why reinvent the wheel?

If the answer to both questions is "No," then I know I have to build the capability myself.

You might be thinking, why did I spend time with the discussion above? Well folks, we live in an object-oriented world; moreover, we live in a world where there are a lot of software developers. Someone, somewhere had to think the along the same lines. So as a rule of thumb, before I make an attempt to write a specialized function or component, I always do research to make sure it hasn't been created elsewhere. That said, let's move on, shall we?

First of all, let's talk about Paradox passwords. Paradox has a hierarchical password system. Each table can have a master password that defines any access to it. In addition a table can have several auxilliary passwords that define table and field rights, limiting access in very specialized ways.

In general, though, I've found that encrypting a table with just a master table is adequate because most of the programs I've created that require data encryption only require "all or nothing" security. Besides, having to cover the ins and outs of auxilliary passwords in Delphi would have created an artilce that was just too long. In any case, let me list the code below that will add a master password to a Paradox table, then we'll discuss particulars following it. Here goes...

procedure EncryptPDOXTable(TableName,
  Password: string);
var
  TblDesc: CRTblDesc;
  LocDB: TDatabase;
begin
  //Initialize the BDE
  Check(DBIInit(nil));

  //Initialize random number generator
  Randomize;

  //Create a local, non-owned database object that
  //points to the path associated with the table.
  LocDB := TDatabase.Create(nil);
  with LocDB do
  begin
    Params.Add('path=' + ExtractFilePath(TableName));
    DatabaseName := 'PDOXEncryptDB' + IntToStr(Random(50));
    DriverName := 'STANDARD';
    Connected := True;
  end;

  //Now, initialize the Table Descriptor with the values
  //required to set a master password.
  FillChar(TblDesc, SizeOf(CRTblDesc), 0);
  StrPCopy(TblDesc.szTblName, ExtractFileName(TableName));
  with TblDesc do
  begin
    bProtected := True;
    StrPCopy(TblDesc.szPassword, Password);
  end;

  //Now do the restructure.
  try
    Check(DbiDoRestructure(LocDB.Handle, 1, @TblDesc,
      nil, nil, nil, False));
  finally
    LocDB.Free;
    DBIExit;
  end;
end;

I think you've figured out by now that to create a master password in a Paradox table, you have to use direct BDE calls. And while it may seem a bit complex, it's actually pretty easy. You'll notice that I put a couple of words in the code in boldface type. These are the two things that you really have to worry about as far as setting a password. The other stuff is pretty routine stuff. So looked at from that perspective simplifies the process entirely. Why don't we discuss the code in a bit more detail.

The first things that I do in the procedure is to initialize the BDE and create a TDatabase object. You'll find that almost all things that you do in the BDE require a database handle of some sort. DbiDoRestructure is no exception. With respect to initializing the BDE, that's purely an option, but something that I've done as a habit primarily because some of my programs don't make use of any data aware components, and thus won't initialize the BDE by default. If you make calls to the BDE without it having been initialized in some way, you'll get an initialization error. So it's a good idea to do this.

The next thing that happens in the code is that I initialize a table descriptor structure. This is a standard structure defined in the BDE that tells BDE functions that use it, like DbiDoRestructure, about the table that they're going to work with. CRTblDesc is a fairly complex structure that has substructures attached to it. If you want to know more about what kinds of fields are in this structure, I suggest looking in the BDE help file in the BDE directory on your hard disk. But the way cool thing about CRTblDesc is that you only need to fill in the fields that are pertinent to the operation you want to perform. In the case of adding a password to a table, all you need to fill in are the szTblName field and szPassword field. That's it.

Then, once the structure has been filled with proper values, it's a simple matter of calling DbiDoRestructure to restructure the table. We supply the handle to the database that was created at the top, the number of table descriptors we're using (1), the address to the table descriptor, then set the next three parameters to "nil" and the last parameter to False. Easy.

If you want to know more about using DbiDoRestructure (since it's obviously used to do many more table operations than what I just discussed) I encourage you to study the online help, or obtain a copy of the "Borland Database Engine Developer's Guide" which you can purchase directly from Borland. Cheers!

Create a (unique) GUID (2)

Problem/Question/Abstract:

I have a very simple piece of test code to generate and display a GUID on the screen every time a user clicks on a button on a form. When I compile the program and run the executable on my Windows 2000 machine, I get a unique GUID every time I click the button, which is what I expect from the documentation. However, when I run the same executable on any Windows 98 SE machine, and even a Windows NT 4.0 Server (with SP5), it simply generates the exact same GUID over, and over, and over again.

Answer:

Using RAW API:

{ ... }
var
  Form1: TForm1;
  UuidCreateFunc: function(var guid: TGUID): HResult; stdcall;

implementation

{$R *.DFM}

uses
  ComObj;

procedure TForm1.Button1Click(Sender: TObject);
var
  hr: HRESULT;
  m_TGUID: TGUID;
  handle: THandle;
begin
  handle := LoadLibrary('RPCRT4.DLL');
  @UuidCreateFunc := GetProcAddress(Handle, 'UuidCreate');
  hr := UuidCreateFunc(m_TGUID);
  if failed(hr) then
    RaiseLastWin32Error;
  ShowMessage(GUIDToString(m_TGUID));
end;

With WIN2K support:

{ ... }
var
  Form1: TForm1;
  UuidCreateFunc: function(var guid: TGUID): HResult; stdcall;

implementation

{$R *.DFM}

uses
  ComObj;

procedure TForm1.Button1Click(Sender: TObject);
var
  hr: HRESULT;
  m_TGUID: TGUID;
  handle: THandle;
  WinVer: _OSVersionInfoA;
begin
  handle := LoadLibrary('RPCRT4.DLL');
  WinVer.dwOSVersionInfoSize := sizeof(WinVer);
  getversionex(WinVer);
  if WinVer.dwMajorVersion >= 5 then {Windows 2000 }
    @UuidCreateFunc := GetProcAddress(Handle, 'UuidCreateSequential')
  else
    @UuidCreateFunc := GetProcAddress(Handle, 'UuidCreate');
  hr := UuidCreateFunc(m_TGUID);
  if failed(hr) then
    RaiseLastWin32Error;
  ShowMessage(GUIDToString(m_TGUID));
end;

How to store and retrieve a text file in / from a resource

Problem/Question/Abstract:

I am trying to work out how to store approximately 1000 lines of text (3 columns, 30 chars each) inside an application. I do not want to have any .INI entries and would prefer not to use an external file.

Answer:

You can start with one and embed it into a resource. Let's assume you have the data in a normal textfile. Make a resource script file (filedata.rc) with a line like

FILEDATA RCDATA filedata.txt

Add this RC file to your Delphi 5 project group. This automatically gets you a $R line for it in the project DPR file and the resource is compiled for you when you build the project. Now, how to get at the data at runtime? Each line is a fixed length of 90 characters. So the file could be represented as an array of records of this type:

type
  TFileData = packed record
    col1, col2, col3: array[1..30] of Char;
    crlf: array[1..2] of Char;
  end;
  PFileData = ^TFileData;

Let's use a class to regulate access to the data. I assume you only need to read it, so there is no need to copy it from the resource.

type
  TDatahandler = class
  private
    FData: TList;
    FResHandle: THandle;
    function GetRecord(index: Integer): TFileData;
    procedure GetRecordCount: Integer;
    procedure InitDatalist;
  public
    constructor Create;
    destructor Destroy; override;
    property Records[index: Integer]: TFileData read GetRecord;
    property Recordcount: Integer read GetRecordcount;
  end;

implementation

constructor TDatahandler.Create;
begin
  inherited;
  FData := TList.Create;
  InitDatalist;
end;

destructor TDatahandler.Destroy;
begin
  Fdata.Free;
  if FResHandle <> 0 then
  begin
    UnlockResource(FResHandle);
    FreeResource(FResHandle);
  end;
  inherited;
end;

function TDatahandler.GetRecord(index: Integer): TFileData;
begin
  Result := PFileData(FData[i])^;
end;

procedure TDatahandler.GetRecordCount: Integer;
begin
  Result := FData.Count;
end;

procedure TDatahandler.InitDatalist;
var
  dHandle: THandle;
  pData: PFileData;
  numRecords, i: Integer;
begin
  pData := nil;
  dHandle := FindResource(hInstance, 'FILEDATA', RT_RCDATA);
  if dHandle <> 0 then
  begin
    numRecord := SizeofResource(hInstance, dHandle) div Sizeof(TFiledata);
    FResHandle := LoadResource(hInstance, dHandle);
    if FResHandle <> 0 then
    begin
      pData := LockResource(dHandle);
      if pData <> nil then
      begin
        FData.Capacity := NumRecords;
        for i := 1 to Numrecords do
        begin
          FData.Add(pData);
          Inc(pData);
        end;
      end
      else
        raise Exception.Create('Lock failed');
    end
    else
      raise Exception.Create('Load failed');
  end
  else
    raise Exception.Create('Resource not found');
end;

You can add a method to sort the FData list, for example, or a filter method that would populate another TList with pointer to records that match a set of criteria.

How to sort a TCheckListBox without loosing the check state

Problem/Question/Abstract:

How to sort a TCheckListBox without loosing the check state

Answer:

Sorting without loosing the check state is a bit of a challenge, but it can be done. The code below has only been superficially tested:

{ ... }
type
  TItemState = class
  public
    Data: TObject;
    Checked: Boolean;
    constructor Create(aData: TObject; aChecked: Boolean);
  end;

constructor TItemState.Create(aData: TObject; aChecked: Boolean);
begin
  inherited Create;
  Data := aData;
  Checked := aChecked;
end;

procedure CustomSortChecklist(aList: TChecklistbox; Compare: TStringListSortCompare = nil);
var
  sl: TStringlist;
  i: Integer;
  stateobj: TItemState;
begin
  Assert(Assigned(aList), 'CustomSortChecklist: no list to sort.');
  sl := TStringlist.Create;
  try
    sl.Assign(aList.Items);
    for i := 0 to sl.Count - 1 do
      sl.Objects[i] := TItemState.Create(sl.Objects[i], aList.Checked[i]);
    if Assigned(Compare) then
      sl.CustomSort(Compare)
    else
      sl.Sort;
    alist.Items.BeginUpdate;
    try
      aList.Clear;
      for i := 0 to sl.Count - 1 do
      begin
        stateobj := sl.Objects[i] as TItemState;
        aList.Items.AddObject(sl[i], stateobj.Data);
        aList.Checked[i] := stateobj.Checked;
      end;
    finally
      aList.Items.EndUpdate;
    end;
  finally
    for i := 0 to sl.Count - 1 do
      if Assigned(sl.Objects[i]) and (sl.Objects[i] is TItemState) then
        sl.Objects[i].Free;
    sl.free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CustomSortChecklist(checklistbox1);
end;

function ReverseSort(List: TStringList; Index1, Index2: Integer): Integer;
begin
  result := AnsiCompareText(list[index2], list[index1]);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  CustomSortChecklist(checklistbox1, Reversesort);
end;

Hacking the Help Files

Problem/Question/Abstract:

Hacking the Help Files

Answer:

I often get tired of help files with broken links, topics that are hard to get to and difficult navigation. However, there's a great way you can use the arrow keys (along with SHIFT+CTRL) to navigate through the help files.

To be able to navigate through the help files using CTRL+SHIFT+arrow key (left or right), add the following lines to WIN.INI:

[Windows Help]
Help Author=1

This will enabled "Help Author Mode" on Windows. What it means is that you'll have special privileges on help files, such as:

Topic numbers: Title bar text is replaced by unique topic numbers that identify each topic's position in the Help file.
Easier navigation: You can move to the following or preceding topic by pressing CTRL+SHIFT+RIGHT ARROW or CTRL+SHIFT+LEFT ARROW. To move to the beginning or end of your Help file, press CTRL+SHIFT+HOME or CTRL+SHIFT+END.
Information about topics A Topic Information command appears when you click a topic by using your right mouse button. Clicking this command displays a window with several info reagrding that topic.
Information about hotspots An Ask On Hotspots command appears when you click a topic by using your right mouse button.

This information is documented in the Microsoft Help Workshop 4.0 (HCW.EXE) help file. If you have installed Delphi, you probably have this this tool installed in the Help\MSTools dir under the Delphi installation directory. You'll can also gather lots of information about a help file by using the Report... command on the file menu of Help Workshop.

MS Help Workshop has helped me gather lots of info on other help files, and even find out topics the author probably want to keep as a secret, if that is possible. For example, you can save all the text of a help file to a plain text file, or save a listing of all the topics of a help file to a text file.

"Help Author Mode" can also be enabled by selecting "Help Author" from the File menu of MS Help workshop.

Some useful Windows NT functions

Problem/Question/Abstract:

Some useful Windows NT functions

Answer:

{-----------------------------------------------------------------------------
Unit Name:     unitNTFunctions
Author:        StewartM

Documentation Date: 22 February, 2002 (11:04)

Version 1.0
-----------------------------------------------------------------------------

Purpose:
  To provide a few handy Windows NT API functions.

Description:

  Unit written by Stewart Moss (except where indicated)
  Some of the functions are incomplete or not tested.

Copyright 2001 by Stewart Moss. All rights reserved.
-----------------------------------------------------------------------------}

unit unitNTFunctions;
// Unit written by Stewart Moss (except where indicated)

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

const
  BSECURITY_NULL_SID_AUTHORITY = 0;
  BSECURITY_WORLD_SID_AUTHORITY = 1;
  BSECURITY_LOCAL_SID_AUTHORITY = 2;
  BSECURITY_CREATOR_SID_AUTHORITY = 3;
  BSECURITY_NT_AUTHORITY = 5;

  SECURITY_INTERACTIVE_RID = $00000004;
  SECURITY_BUILTIN_DOMAIN_RID = $00000020;
  DOMAIN_ALIAS_RID_ADMINS = $00000220;

  ACL_REVISION = 2;
  SECURITY_DESCRIPTOR_REVISION = 1;

type
  PACE_Header = ^TACE_Header;
  TACE_Header = record
    AceType: BYTE;
    AceFlags: BYTE;
    AceSize: WORD;
  end;

  PAccess_Allowed_ACE = ^TAccess_Allowed_ACE;
  TAccess_Allowed_ACE = record
    Header: TACE_Header;
    Mask: ACCESS_MASK;
    SidStart: DWORD;
  end;
const
  SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority =
  (Value: (0, 0, 0, 0, 0, 5));

function ISHandleAdministrator(UserToken: THandle): Boolean;
function IsAdmin: Boolean;
function ReturnUserHandle(Username: string): THandle;
function IsWinNT: boolean;

function TryToLoginAsUser(Username, Domain, Password: string): THandle;

implementation

function ISHandleAdministrator(UserToken: THandle): Boolean;
// this function written by Stewart Moss
var
  tmpBuffer: array[0..1024] of char;
  BufferPtr: Pointer;
  ptgGroups: PTokenGroups;
  dwInfoBufferSize: DWord;
  PSIDAdministrators: PSID;
  siaNTAuthority: SID_IDENTIFIER_AUTHORITY;
  X: DWord;
  bSuccess: Boolean;

begin
  GetMem(PtgGroups, 1024);

  bSuccess := GetTokenInformation(UserToken, TokenGroups, ptgGroups,
    1024, dwInfoBufferSize);
  result := false;
  if not bsuccess then
    exit;

  if not AllocateAndInitializeSid(siaNtAuthority, 2,
    SECURITY_BUILTIN_DOMAIN_RID,
    DOMAIN_ALIAS_RID_ADMINS,
    0, 0, 0, 0, 0, 0,
    psidAdministrators) then
    exit;

  for x := 0 to ptgGroups.GroupCount do
  begin
    if EqualSID(psidAdministrators, ptgGroups.Groups[x].SID) then
    begin
      result := true;
      break;
    end;
  end;
  freemem(PtgGroups);
  Freemem(PsidAdministrators);
  result := true;
end;

function IsAdmin: Boolean;
// This function written by somebody else
var
  hAccessToken: THandle;
  ptgGroups: PTokenGroups;
  dwInfoBufferSize: DWORD;
  psidAdministrators: PSID;
  x: Integer;
  bSuccess: BOOL;
begin
  Result := False;
  bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True,
    hAccessToken);
  if not bSuccess then
  begin
    if GetLastError = ERROR_NO_TOKEN then
      bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY,
        hAccessToken);
  end;
  if bSuccess then
  begin
    GetMem(ptgGroups, 1024);
    bSuccess := GetTokenInformation(hAccessToken, TokenGroups,
      ptgGroups, 1024, dwInfoBufferSize);
    CloseHandle(hAccessToken);
    if bSuccess then
    begin
      AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
        SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS,
        0, 0, 0, 0, 0, 0, psidAdministrators);
{$R-}
      for x := 0 to ptgGroups.GroupCount - 1 do
        if EqualSid(psidAdministrators, ptgGroups.Groups[x].Sid) then
        begin
          Result := True;
          Break;
        end;
{$R+}
      FreeSid(psidAdministrators);
    end;
    FreeMem(ptgGroups);
  end;
end;

function ReturnUserHandle(Username: string): THandle;
// Function written by Stewart Moss
begin

end;

function IsWinNT: boolean;
// Function Written by Stewart Moss
var
  osv: TOSVERSIONINFO;
begin
  result := false;
  osv.dwOSVersionInfoSize := sizeOf(OSVERSIONINFO);
  GetVersionEx(osv);
  if (osv.dwPlatformId = VER_PLATFORM_WIN32_NT) then
    result := true;
end;

function TryToLoginAsUser(Username, Domain, Password: string): THandle;
// Function written by Stewart Moss
// returns 0 if failed else User Handle
var
  tmpstr: string;
  hToken: THandle;
begin
  result := 0;

  if (UserName = '') or (Domain = '') then
    exit;

  if not LogonUser(PChar(Username), Pchar(Domain), PChar(Password),
    LOGON32_LOGON_INTERACTIVE,
    LOGON32_PROVIDER_DEFAULT, hToken) then
    exit;
  result := hToken;
end;

(*function ApplySecurityDescriptorToRegistryKey(Key : Hkey): Boolean;
var lRv : longint;
  siaNtAuthority : SID_IDENTIFIER_AUTHORITY;
  psidSystem, psidAdministrators: PSID;
  tmpACL : ACL;
  pNewDACL : PACL;
  dwACL : DWord;
  ACLRevision : ACL_REVISION_INFORMATION;
begin
    siaNtAuthority := SECURITY_NT_AUTHORITY;
    result := false;
    InitializeSid(psidAdministrators, siaNtAuthority,2);
    InitializeSid(psidSystem, siaNtAuthority,1);

    //*(GetSidSubAuthority(psidAdministrators,0)) = SECURITY_BUILTIN_DOMAIN_RID;
    //*(GetSidSubAuthority(psidAdministrators,1)) = DOMAIN_ALIAS_RID_ADMINS;
    //*(GetSidSubAuthority(psidSystem,0)) = SECURITY_LOCAL_SYSTEM_RID;

//    getmem(pNewDACL, sizeof(PACL));
//    pNewDACL := tmpAcl;

    dwAcl := sizeof(PACL);

    if not GETAclInformation(pnewAcl,

    if (not InitializeAcl(pnewDACL,
                       dwACL,
                       ACL_REVISION))  then exit;

    if (!AddAccessAllowedAce(pNewDACL,
                             ACL_REVISION,
                             KEY_ALL_ACCESS,
                             psidAdministrators)) return FALSE;

    if (!AddAccessAllowedAce(pNewDACL,
                             ACL_REVISION,
                             KEY_ALL_ACCESS,
                             psidSystem)) return FALSE;

    if (!InitializeSecurityDescriptor(psdAbsoluteSD,
                                      SECURITY_DESCRIPTOR_REVISION)) return FALSE;

    if (!SetSecurityDescriptorDacl(psdAbsoluteSD,
                                   TRUE,      // fDaclPresent flag
                                   pNewDACL,
                                   FALSE))    // not a default DACL
                                           return FALSE;

    if (!IsValidSecurityDescriptor(psdAbsoluteSD)) return FALSE;

    lRv=RegSetKeySecurity(hKey,
                         (SECURITY_INFORMATION)(DACL_SECURITY_INFORMATION),
                         psdAbsoluteSD);
    if (lRv!=ERROR_SUCCESS) return FALSE;

    return TRUE;
}

*)

function do_SetRegACL: boolean;
var
  sia: TSIDIdentifierAuthority;
  pInteractiveSid, pAdministratorsSid: PSID;
  sd: Windows.TSecurityDescriptor;
  pDacl: PACL;
  dwAclSize: DWORD;
  aHKey: HKEY;
  lRetCode: longint;
  bSuccess: boolean;
begin

  sia.Value[0] := 0;
  sia.Value[1] := 0;
  sia.Value[2] := 0;
  sia.Value[3] := 0;
  sia.Value[4] := 0;
  sia.Value[5] := BSECURITY_NT_AUTHORITY;
  pInteractiveSid := nil;
  pAdministratorsSid := nil;
  pDacl := nil;

  bSuccess := false; // assume this function fails

  //
  // open the key for WRITE_DAC access
  //
  lRetCode := RegOpenKeyEx(
    HKEY_CURRENT_USER,
    'SOFTWARE\Test',
    0,
    WRITE_DAC,
    aHKey
    );

  if (lRetCode <> ERROR_SUCCESS) then
  begin
    ShowMessage('Error in RegOpenKeyEx');
    result := false;
  end;

  //
  // prepare a Sid representing any Interactively logged-on user
  //
  if (not AllocateAndInitializeSid(
    sia,
    1,
    SECURITY_INTERACTIVE_RID,
    0, 0, 0, 0, 0, 0, 0,
    pInteractiveSid
    )) then
  begin
    ShowMessage('Error in: AllocateAndInitializeSid');
    //goto cleanup;
  end;

  //
  // prepare a Sid representing the well-known admin group
  //
  if (not AllocateAndInitializeSid(
    sia,
    2,
    SECURITY_BUILTIN_DOMAIN_RID,
    DOMAIN_ALIAS_RID_ADMINS,
    0, 0, 0, 0, 0, 0,
    pAdministratorsSid
    )) then
  begin
    ShowMessage('Error in: AllocateAndInitializeSid');
    // goto cleanup;
  end;

  //
  // compute size of new acl
  //
  dwAclSize := sizeof(TACL) +
    2 * (sizeof(TAccess_Allowed_ACE) - sizeof(DWORD)) +
    GetLengthSid(pInteractiveSid) +
    GetLengthSid(pAdministratorsSid);

  //
  // allocate storage for Acl
  //
  pDacl := PACL(HeapAlloc(GetProcessHeap(), 0, dwAclSize));
  //if(pDacl == nil) goto cleanup;

  if (not InitializeAcl(pDacl^, dwAclSize, ACL_REVISION)) then
  begin
    ShowMessage('Error in: InitializeAcl');
    //goto cleanup;
  end;

  //
  // grant the Interactive Sid KEY_READ access to the perf key
  //
  if (not AddAccessAllowedAce(
    pDacl^,
    ACL_REVISION,
    KEY_READ,
    pInteractiveSid
    )) then
  begin
    ShowMessage('Error in: AddAccessAllowedAce');
    //goto cleanup;
  end;

  //
  // grant the Administrators Sid KEY_ALL_ACCESS access to the perf key
  //
  if (not AddAccessAllowedAce(
    pDacl^,
    ACL_REVISION,
    KEY_ALL_ACCESS,
    pAdministratorsSid
    )) then
  begin
    ShowMessage('Error in: AddAccessAllowedAce');
    //goto cleanup;
  end;

  if (not InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION)) then
  begin
    ShowMessage('Error in: InitializeSecurityDescriptor');
    //goto cleanup;
  end;

  if (not SetSecurityDescriptorDacl(@sd, TRUE, pDacl, FALSE)) then
  begin
    ShowMessage('Error in: SetSecurityDescriptorDacl');
    //goto cleanup;
  end;

  //
  // apply the security descriptor to the registry key
  //
  lRetCode := RegSetKeySecurity(
    aHKey,
    SECURITY_INFORMATION(DACL_SECURITY_INFORMATION),
    @sd
    );

  if (lRetCode <> ERROR_SUCCESS) then
  begin
    ShowMessage('Error in: RegSetKeySecurity');
    //goto cleanup;
  end;

  bSuccess := TRUE; // indicate success

end;

end.

Make a form use two frames in separate units

Problem/Question/Abstract:

How can I make a function which will create a frame (given its class) in a new form?

Answer:

Maybe you should use an enumerated value which is an index of an array of your frame classes. An example with a form using two frames in seperate units:

unit UnitTestForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, UnitFrameOne, UnitFrameTwo;

type
  {'class of' and enumeration}
  TFrameClass = class of TFrame;
  TFrameEnm = (frm_one, frm_two);

  {array of classes}
  TFrameClasses = array[TFrameEnm] of TFrameClass;

  {test form}
  TForm1 = class(TForm)
    btnCreateFrame1: TButton;
    btnCreateFrame2: TButton;
    procedure btnCreateFrame1Click(Sender: TObject);
    procedure btnCreateFrame2Click(Sender: TObject);
  private
    function CreateFrame(FrameEnm: TFrameEnm): TForm;
  public
  end;

var
  Frames: TFrameClasses = (TFrameOne, TFrameTwo);

  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnCreateFrame1Click(Sender: TObject);
var
  Form: TForm;
begin
  Form := Self.CreateFrame(frm_one);
  Form.ShowModal;
end;

procedure TForm1.btnCreateFrame2Click(Sender: TObject);
var
  Form: TForm;
begin
  Form := Self.CreateFrame(frm_two);
  Form.ShowModal;
end;

function TForm1.CreateFrame(FrameEnm: TFrameEnm): TForm;
var
  aFrame: TFrame;
begin
  Result := TForm.Create(nil);
  aFrame := Frames[FrameEnm].Create(Result);
  aFrame.Parent := Result;
  aFrame.Align := alClient;
end;

How to convert accented characters to unaccented ones

Problem/Question/Abstract:

Is there a way to convert accented characters to unaccented (meaning ASCII A - Z, a - z)?

Answer:

The classical way is to have a conversion table and do a lookup in that table. The problem with that is that the table is of course specific to a certain charset (encoding), like Windows Latin-1. You could build a table for a range of UNICODE (widechar) characters to get around this limitation and convert the strings to widestrings before you do the accent removals. The routine below uses ANSI characters with the Windows western (Latin-1) encoding.

function SimplifyChar(const _ch: char): char;
const
  Charmap: array[#128..#255] of Char = (
    #128 { ? }, #129 { ? }, #130 { ? }, #131 { ? }, #132 { ? },
    #133 { ? }, #134 { ? }, #135 { ? }, #136 { ? }, #137 { ? },
    #138 { ? }, #139 { ? }, #140 { ? }, #141 { ? }, #142 { ? },
    #143 { ? }, #144 { ? }, #145 { ? }, #146 { ? }, #147 { ? },
    #148 { ? }, #149 { ? }, #150 { ? }, #151 { ? }, #152 { ? },
    #153 { ? }, #154 { ? }, #155 { ? }, #156 { ? }, #157 { ? },
    #158 { ? }, #159 { ? }, #160 { � }, #161 { &middot; }, #162 { � },
    #163 { � }, #164 { � }, #165 { � }, #166 { &brvbar; }, #167 { � },
    #168 { � }, #169 { &copy; }, #170 { � }, #171 { &laquo; }, #172 { &not; },
    #173 {  }, #174 { &reg; }, #175 { � }, #176 { � }, #177 { &plusmn; },
    #178 { � }, #179 { � }, #180 { � }, #181 { &micro; }, #182 { &para; },
    #183 { &middot; }, #184 { � }, #185 { &plusmn; }, #186 { � }, #187 { &raquo; },
    #188 { � }, #189 { � }, #190 { &micro; }, #191 { � }, 'A' { � },
    'A' { � }, 'A' { � }, 'A' { � }, 'A' { � }, 'A' { � },
    #198 { � }, #199 { � }, 'E' { � }, 'E' { � }, 'E' { � },
    'E' { � }, 'I' { � }, 'I' { � }, 'I' { � }, 'I' { � },
    #208 { � }, #209 { � }, 'O' { � }, 'O' { � }, 'O' { � },
    'O' { � }, 'O' { � }, #215 { � }, #216 { � }, 'U' { � },
    'U' { � }, 'U' { � }, 'U' { � }, #221 { � }, #222 { � },
    #223 { � }, 'a' { � }, 'a' { � }, 'a' { � }, 'a' { � },
    'a' { � }, 'a' { � }, #230 { � }, #231 { � }, 'e' { � },
    'e' { � }, 'e' { � }, 'e' { � }, 'i' { � }, 'i' { � },
    'i' { � }, 'i' { � }, #240 { � }, #241 { � }, 'o' { � },
    'o' { � }, 'o' { � }, 'o' { � }, 'o' { � }, #247 { � },
    #248 { � }, 'u' { � }, 'u' { � }, 'u' { � }, 'u' { � },
    #253 { � }, #254 { � }, #255 { � }
    );
begin
  if _ch >= #128 then
    Result := Charmap[_ch]
  else
    Result := _ch;
end;

The charmap table was created by this little routine and then edited:

procedure CreateCharacterMap(fromchar, tochar: Char);

function DisplayStr(const ch: Char): string;
begin
  if ch < #32 then
    Result := '^' + Chr(Ord('A') - 1 + Ord(ch))
  else
    Result := ch;
end;

var
  sl: TStringlist;
  line, element: string;
  ch: char;
begin
  Assert(fromchar <= tochar);
  sl := Tstringlist.Create;
  try
    sl.Add('Const');
    line := Format('  Charmap: array [#%d..#%d] of Char = (', [Ord(fromchar),
      Ord(tochar)]);
    sl.Add(line);
    line := '';
    for ch := fromchar to toChar do
    begin
      element := Format('#%3.3d { %s }', [Ord(ch), DisplayStr(ch)]);
      if (Length(line) + Length(element)) > 66 then
      begin
        sl.Add('    ' + line);
        line := '';
      end;
      line := line + element;
      if ch <> tochar then
        line := line + ', ';
    end;
    sl.Add('    ' + line);
    sl.add('    );');
    Clipboard.AsText := sl.Text;
  finally
    sl.Free
  end;
end;