create a registry entry in the autorun key

There's a RunOnce key in the registry.
When a user logs on, the programs in the run-once list are run just once,
and then the entries will be removed.
The "runonce" key is normally used by setup programs to install
software after a machine has been rebooted.


// Add the application to the registry...

procedure DoAppToRunOnce(RunName, AppName: string);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
with Reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('Software\Microsoft\Windows\CurrentVersion\RunOnce', True);
WriteString(RunName, AppName);
CloseKey;
Free;
end;
end;

// Check if the application is in the registry...
// Prüfen, ob Anwendung in der Registry vorhanden ist...

function IsAppInRunOnce(RunName: string): Boolean;
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
with Reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('Software\Microsoft\Windows\CurrentVersion\RunOnce', False);
Result := ValueExists(RunName);
CloseKey;
Free;
end;
end;

// Remove the application from the registry...
// Anwendung aus der Registry entfernen...

procedure DelAppFromRunOnce(RunName: string);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
with Reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('Software\Microsoft\Windows\CurrentVersion\RunOnce', True);
if ValueExists(RunName) then DeleteValue(RunName);
CloseKey;
Free;
end;
end;

{
Applications under the key "Run" will be executed
each time the user logs on.
{

{
Jede Anwendung, die im Schlüssel Run aufgeführt ist, wird beim
jedem Windowsstart ausgeführt. Betrifft Anwendungen, die immer
mit Windows gestartet werden sollen...
}


// Add the application to the registry...
// Anwendung in die Registry aufnehmen...

procedure DoAppToRun(RunName, AppName: string);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
with Reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', True);
WriteString(RunName, AppName);
CloseKey;
Free;
end;
end;

// Check if the application is in the registry...
// Prüfen, ob Anwendung in der Registry vorhanden ist...

function IsAppInRun(RunName: string): Boolean;
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
with Reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', False);
Result := ValueExists(RunName);
CloseKey;
Free;
end;
end;

// Remove the application from the registry...
// Anwendung aus der Registry entfernen...

procedure DelAppFromRun(RunName: string);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
with Reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', True);
if ValueExists(RunName) then DeleteValue(RunName);
CloseKey;
Free;
end;
end;

// Examples, Beispiele

// Add app, Anwendung aufnehmen...
DoAppToRun('Programm', 'C:\Programs\XYZ\Program.exe');

// Is app there ? Ist Anwendung vorhanden?
if IsAppInRun('Programm') then...

// Remove app, Anwendung entfernen
DelAppFromRun('Programm');

shutdown / reboot / logoff Windows 9x/NT/Me/2000/XP/Win7

function MyExitWindows(RebootParam: Longword): Boolean;
var
  TTokenHd: THandle;
  TTokenPvg: TTokenPrivileges;
  cbtpPrevious: DWORD;
  rTTokenPvg: TTokenPrivileges;
  pcbtpPreviousRequired: DWORD;
  tpResult: Boolean;
const
  SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    tpResult := OpenProcessToken(GetCurrentProcess(),
      TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
      TTokenHd);
    if tpResult then
    begin
      tpResult := LookupPrivilegeValue(nil,
                                       SE_SHUTDOWN_NAME,
                                       TTokenPvg.Privileges[0].Luid);
      TTokenPvg.PrivilegeCount := 1;
      TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      cbtpPrevious := SizeOf(rTTokenPvg);
      pcbtpPreviousRequired := 0;
      if tpResult then
        Windows.AdjustTokenPrivileges(TTokenHd,
                                      False,
                                      TTokenPvg,
                                      cbtpPrevious,
                                      rTTokenPvg,
                                      pcbtpPreviousRequired);
    end;
  end;
  Result := ExitWindowsEx(RebootParam, 0);
end;

// Example to shutdown Windows:

procedure TForm1.Button1Click(Sender: TObject);
begin
  MyExitWindows(EWX_POWEROFF or EWX_FORCE);
end;

// Example to reboot Windows:

procedure TForm1.Button1Click(Sender: TObject);
begin
  MyExitWindows(EWX_REBOOT or EWX_FORCE);
end;


// Parameters for MyExitWindows()


{************************************************************************}

{2. Console Shutdown Demo}

program Shutdown;
{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows;

// Shutdown Program
// (c) 2000 NeuralAbyss Software
// www.neuralabyss.com

var
  logoff: Boolean = False;
  reboot: Boolean = False;
  warn: Boolean = False;
  downQuick: Boolean = False;
  cancelShutdown: Boolean = False;
  powerOff: Boolean = False;
  timeDelay: Integer = 0;

function HasParam(Opt: Char): Boolean;
var
  x: Integer;
begin
  Result := False;
  for x := 1 to ParamCount do
    if (ParamStr(x) = '-' + opt) or (ParamStr(x) = '/' + opt) then Result := True;
end;

function GetErrorstring: string;
var
  lz: Cardinal;
  err: array[0..512] of Char;
begin
  lz := GetLastError;
  FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, lz, 0, @err, 512, nil);
  Result := string(err);
end;

procedure DoShutdown;
var
  rl, flgs: Cardinal;
  hToken: Cardinal;
  tkp: TOKEN_PRIVILEGES;
begin
  flgs := 0;
  if downQuick then flgs := flgs or EWX_FORCE;
  if not reboot then flgs := flgs or EWX_SHUTDOWN;
  if reboot then flgs := flgs or EWX_REBOOT;
  if poweroff and (not reboot) then flgs := flgs or EWX_POWEROFF;
  if logoff then flgs := (flgs and (not (EWX_REBOOT or EWX_SHUTDOWN or EWX_POWEROFF))) or
      EWX_LOGOFF;
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    if not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
      hToken) then
      Writeln('Cannot open process token. [' + GetErrorstring + ']')
    else
    begin
      if LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid) then
      begin
        tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
        tkp.PrivilegeCount           := 1;
        AdjustTokenPrivileges(hToken, False, tkp, 0, nil, rl);
        if GetLastError <> ERROR_SUCCESS then
          Writeln('Error adjusting process privileges.');
      end
      else
        Writeln('Cannot find privilege value. [' + GetErrorstring + ']');
    end;
    {   if CancelShutdown then
          if AbortSystemShutdown(nil) = False then
            Writeln(\'Cannot abort. [\' + GetErrorstring + \']\')
          else
           Writeln(\'Cancelled.\')
       else
       begin
         if InitiateSystemShutdown(nil, nil, timeDelay, downQuick, Reboot) = False then
            Writeln(\'Cannot go down. [\' + GetErrorstring + \']\')
         else
            Writeln(\'Shutting down!\');
       end;
    }
  end;
  //     else begin
  ExitWindowsEx(flgs, 0);
  //     end;
end;

begin
  Writeln('Shutdown v0.3 for Win32 (similar to the Linux version)');
  Writeln('(c) 2000 NeuralAbyss Software. All Rights Reserved.');
  if HasParam('?') or (ParamCount = 0) then
  begin
    Writeln('Usage:    shutdown [-akrhfnc] [-t secs]');
    Writeln('                  -k:      don''t really shutdown, only warn.');
    Writeln('                  -r:      reboot after shutdown.');
    Writeln('                  -h:      halt after shutdown.');
    Writeln('                  -p:      power off after shutdown');
    Writeln('                  -l:      log off only');
    Writeln('                  -n:      kill apps that don''t want to die.');
    Writeln('                  -c:      cancel a running shutdown.');
  end
  else
  begin
    if HasParam('k') then warn := True;
    if HasParam('r') then reboot := True;
    if HasParam('h') and reboot then
    begin
      Writeln('Error: Cannot specify -r and -h parameters together!');
      Exit;
    end;
    if HasParam('h') then reboot := False;
    if HasParam('n') then downQuick := True;
    if HasParam('c') then cancelShutdown := True;
    if HasParam('p') then powerOff := True;
    if HasParam('l') then logoff := True;
    DoShutdown;
  end;
end.




 
// Parameters for MyExitWindows()


EWX_LOGOFF

Shuts down all processes running in the security context of the process that called the
ExitWindowsEx function. Then it logs the user off.

Alle Prozesse des Benutzers werden beendet, danach wird der Benutzer abgemeldet.

EWX_POWEROFF

Shuts down the system and turns off the power.
The system must support the power-off feature.
Windows NT/2000/XP:
The calling process must have the SE_SHUTDOWN_NAME privilege.

Fährt Windows herunter und setzt den Computer in den StandBy-Modus,
sofern von der Hardware unterstützt.

EWX_REBOOT

Shuts down the system and then restarts the system.
Windows NT/2000/XP: The calling process must have the SE_SHUTDOWN_NAME privilege.

Fährt Windows herunter und startet es neu.

EWX_SHUTDOWN

Shuts down the system to a point at which it is safe to turn off the power.
All file buffers have been flushed to disk, and all running processes have stopped.
If the system supports the power-off feature, the power is also turned off.
Windows NT/2000/XP: The calling process must have the SE_SHUTDOWN_NAME privilege.

Fährt Windows herunter.


EWX_FORCE

Forces processes to terminate. When this flag is set,
the system does not send the WM_QUERYENDSESSION and WM_ENDSESSION messages.
This can cause the applications to lose data.
Therefore, you should only use this flag in an emergency.

Die aktiven Prozesse werden zwangsweise und ohne Rückfrage beendet.

EWX_FORCEIFHUNG

Windows 2000/XP: Forces processes to terminate if they do not respond to the
WM_QUERYENDSESSION or WM_ENDSESSION message. This flag is ignored if EWX_FORCE is used.

Windows 2000/XP: Die aktiven Prozesse werden aufgefordert, sich selbst zu beenden und
müssen dies bestätigen. Reagieren sie nicht, werden sie zwangsweise beendet.

Get a list of computers in a network

Code:
==========================================================
type
  PNetResourceArray = ^TNetResourceArray;
  TNetResourceArray = array[0..100] of TNetResource;

function CreateNetResourceList(ResourceType: DWord;
                              NetResource: PNetResource;
                              out Entries: DWord;
                              out List: PNetResourceArray): Boolean;
var
  EnumHandle: THandle;
  BufSize: DWord;
  Res: DWord;
begin
  Result := False;
  List := Nil;
  Entries := 0;
  if WNetOpenEnum(RESOURCE_GLOBALNET,
                  ResourceType,
                  0,
                  NetResource,
                  EnumHandle) = NO_ERROR then begin
    try
      BufSize := $4000;  // 16 kByte
      GetMem(List, BufSize);
      try
        repeat
          Entries := DWord(-1);
          FillChar(List^, BufSize, 0);
          Res := WNetEnumResource(EnumHandle, Entries, List, BufSize);
          if Res = ERROR_MORE_DATA then
          begin
            ReAllocMem(List, BufSize);
          end;
        until Res <> ERROR_MORE_DATA;
        Result := Res = NO_ERROR;
        if not Result then
        begin
          FreeMem(List);
          List := Nil;
          Entries := 0;
        end;
      except
        FreeMem(List);
        raise;
      end;
    finally
      WNetCloseEnum(EnumHandle);
    end;
  end;
end;


procedure ScanNetworkResources(ResourceType, DisplayType: DWord; List: TStrings);

procedure ScanLevel(NetResource: PNetResource);
var
  Entries: DWord;
  NetResourceList: PNetResourceArray;
  i: Integer;
begin
  if CreateNetResourceList(ResourceType, NetResource, Entries, NetResourceList) then try
    for i := 0 to Integer(Entries) - 1 do
    begin
      if (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or
        (NetResourceList[i].dwDisplayType = DisplayType) then begin
        List.AddObject(NetResourceList[i].lpRemoteName,
                      Pointer(NetResourceList[i].dwDisplayType));
      end;
      if (NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER) <> 0 then
        ScanLevel(@NetResourceList[i]);
    end;
  finally
    FreeMem(NetResourceList);
  end;
end;
begin
  ScanLevel(Nil);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER, ListBox1.Items);
end;

Dragging controls and forms the easy way

Question/Problem/Abstract:
This article shows a technique to drag a form without caption other than responding to NC_HITTEST messages. This technique can also be used to accomplish the dragging of Windowed controls inside the form.
Answer:



The code bellow was created when I was writting a component to allow the dragging of forms without captions. First I found code using the NC_HITTEST message, but the technique presented here offers a lot of other possibilities since it can be applied to any windowed control (not only forms), and will allow you to move them on the form with only 2 or 3 lines of code.

It consists of sendind a WM_SYSCOMMAND message to the desired window (remember that all windowed controls are considered windows on the Windows OS :-) with the correct parameters set, and the window will behave as if the user had started dragging the window by clicking on its caption (this works even with windows without captions, like text boxes.)

The funny part was that this parameter for the WM_SYSCOMMAND message isn't documented (it isn't on my Windows SDK help). I've discovered it while debugging an application. I've put a handler for the WM_SYSCOMMAND message and was showing on the screen all the values for its parameters and to my surprise, when I started to drag the form the value $F012 poped-up. Then I tried to send it to the form and it didn't worked. After a while I figure out how to do it correctly and the code for this follows:

Put the code bellow on the OnMouseDown handler for any form:

procedure TForm1.FormMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F012, 0);
end;
end;

You can also put this code on the OnMouseDown of a single panel or a group of panels, effectively creating a new drag point for the form. When the user tries to drag the panel you send the message above to the form and a dragging operation will start. It is easier to accomplish this with this method than using the NC_HITTEST message:

procedure TForm1.Panel1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F012, 0);
end;
end;

If you write Panel1.Perform(WM_SYSCOMMAND, $F012, 0) the panel will start moving inside the form as if it was itself a form. When you release the mouse it will stay were you left it (no additional code required).

This code can be much useful sometimes, but it is very very simple. Hope you liked it.

Adding Drag & Drop to a TListBox

How do I do drag and drop in a TListbox?

Adding Drag and Drop facilities to a listbox is a matter of checking to see if there is an item under the mouse pointer in the MouseDown event, and if so save the item text and the index number to variables. Then check the MouseUp event to see if there is a different item under the mouse. If so, delete the old item and insert a copy of it in the new position.

Firstly, add three variables to the private section:

{ Private declarations }
Dragging: Boolean;
OldIndex: Integer;
TempStr: String;

Then add the following code to the MouseUp and MouseDown events:

procedure TForm1.ListBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Index: integer;
begin
if Dragging then
begin
Index := ListBox1.ItemAtPos(point(x, y), true);
if (Index > -1) and (Index <> OldIndex) then
begin
ListBox1.Items.Delete(OldIndex);
ListBox1.Items.Insert(Index, TempStr);
ListBox1.ItemIndex := Index;
end;
end;
Dragging := false;
end;

procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Index: integer;
begin
Index := ListBox1.ItemAtPos(point(x, y), true);
if Index > -1 then
begin
TempStr := ListBox1.Items[Index];
OldIndex := Index;
Dragging := true;
end;
end;

Incremental Searches with a TListbox

How can I create a form that has a list box that I can perform an incremental search on?

There are a couple of ways to do this. One's hard and slow, the other easy and fast (we're going to take the easy and fast option).

For those of you who aren't familiar with incremental searching with list boxes, the concept is simple: A user types part of a string into an edit box, then the list box automatically selects one of its items that most closely matches the value typed by the user. For example of this, open up any topic search dialog in a Windows Help file. If you type into the edit box, the list will scroll to the value that most closely matches what you type.

Why is creating a capability like this essential? Because it's tedious to scroll through a list that has lots of items. Imagine if a list contained hundreds of unsorted items. To get to the value you're looking for would take a long time if you only had the capability of scrolling through the list using the vertical scroll bar. But if you knew at least part of the value you're trying to find, entering it into an edit box and getting the item you want immediately is a much more attractive solution.

Let's delve into what you have to do make this work. First, here's the unit code for a sample form I produced:

unit uinclist;

interface

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

type
TForm1 = class(TForm)
ListBox1: TListBox;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
procedure Edit1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
{This is a test string to load into the list box at runtime}
CONST ListStrings = 'United States'#13'Guatemala'#13'Mexico'#13+
'El Salvador'#13'Costa Rica'#13'Yucatan'#13+
'China'#13'Japan'#13'Thailand'#13'Switzerland'#13+
'Germany'#13'Lichtenstein'#13'Jamaica'#13'Greece'+
'Turkey'#13'Ireland'#13'United Kingdom'#13'Scotland'+
'Canada'#13'Uruguay'#13'Paraguay'#13'Cuba'#13+
'Spain'#13'Italy'#13'France'#13'Portugal'#13'New Zealand'#13+
'Austria'#13'Australia'#13'Philippines'#13'Korea'#13+
'Malaysia'#13'Tibet'#13'Nepal'#13'India'#13'Sri Lanka'#13+
'Pakistan'#13+'Saudi Arabia'#13'United Arab Emerates'#13'Iran'#13+
'Ukraine'#13'Belarus'#13+
'Chechen'#13'Yugoslavia'#13'Czechoslovakia'#13'Slovina'#13'Kazakhstan'#13+
'Egypt'#13'Morocco'#13'Macedonia'#13'Cyprus'#13'Finland'#13+
'Norway'#13'Sweden'#13'Denmark'#13'Netherlands'#13'Lithuania'#13;
begin
ListBox1.Items.SetText(ListStrings);
end;

procedure TForm1.Edit1Change(Sender: TObject);
var
S : Array[0..255] of Char;
begin
StrPCopy(S, Edit1.Text);
with ListBox1 do
ItemIndex := Perform(LB_SELECTSTRING, 0, LongInt(@S));
end;

end.

Form1 has two controls: a TEdit and a TListBox. Notice that during FormCreate, I loaded up the value of the list box with the huge string of countries. This was only for testing purposes. How you load up your list is up to you. Now, the trick to making the incremental search is in the OnChange event of Edit1. I've used the Windows message LB_SELECTSTRING to perform the string selection for me. Let's talk about the message.

LB_SELECTSTRING is one of the members of the WinAPI list box message family (all preceeded by LB_) that manipulates all aspects of a list box object in Windows. The message takes two parameters: wParam, the index from which the search should start; and lParam, the address of the null-terminated string to search on. Since WinAPI calls require null-terminated strings, use either a PChar or an Array of Char to pass string values. It's more advantageous to use a an Array of Char if you know a string value won't exceed a certain length. You don't have to manually allocate and de-allocate memory with an Array of Char, as opposed to a PChar that requires you to use GetMem or New and FreeMem to allocate and de-allocate memory.

In any case, to convert a Pascal string to a null-terminated string, just use StrPCopy to copy the contents of the Pascal string into the null-terminated string. Once that's done, all we have to do is pass the address of the null-terminated string into the wParam parameter of LB_SELECTSTRING, and that's done by using the @ symbol.

When we use Perform to execute the LB_SELECTSTRING message, the message will return the item index of the matching list item. Then all that's left to do is assign the ItemIndex property of the list box to the return value of the message. The net result is that the list box will scroll to and select the list element that was found.

There are several list box messages you can perform in Delphi. If you bring up the help system and do a topic search, enter LB_ in the edit box, and peruse the list of messages.

Copyright © 1995, 1996, 1997 Brendan V. Delumpa All Rights Reserved
Delphi Expert Eddie Shipman adds the following useful information:

This procedure can be applied to TComboBox by changing to this code:

procedure TForm1.ComboBox1Change(Sender: TObject);
var
S : Array[0..255] of Char;
begin
StrPCopy(S, TComboBox(Sender).Text);
with ComboBox1 do
ItemIndex := Perform(CB_SELECTSTRING, 0, LongInt(@S));
end;

Manipulating a TRadioGroup's Individual Buttons

Is there a way to manipulate the appearance of the individual buttons in a TRadioGroup?

This subject falls into the yeah, it's something you could do, but should you category. In other words, don't do it just because it's possible. Especially because for what I'll be discussing here, this is pretty much undocumented stuff, and purposely hidden from obvious access.

The Delphi engineers hid a lot of stuff from the visible interface for a good reason: Unless you really know what you're doing and understand the workings of Delphi and the VCL components and its object hierarchy, it's better to leave the internal stuff alone. In fact, I'd venture that 98% of the time you won't need to access any of the hidden features of Delphi. But as we all know, it's that remaining 2% that always kills us. I ran into one of those 2% situations recently.

I had created a form that had a few TRadioGroups with up to 20 items in each on it. The selections specified some standard query selection criteria, which my users could then just set with a few clicks of the mouse, press the OK button and the program would produce a formatted report. No possible mistyping, so no worries about entering in wrong information for the criteria-matching. However, one of my users had a problem with the form in that because the radio groups were side-by-side, it was difficult to immediately tell which selection she had made from one group to the next. So she asked me if I could change the appearance of the item she checked.

So what I did was take advantage of the fact that objects that can act as containers all have an array property called Components, which holds the component index of a contained component relative to the container. TRadioGroup is nothing more than a TWinControl descendant (a few levels down) with a collection of TRadioButtons. And conveniently, the radio buttons in the group are indexed with the ItemIndex property, which in turn corresponds to the index of the Components array. So all we have to do to access an individual TRadioButton in a TRadioGroup is to typecast a Components element as a TRadioButton. What I came up with is fairly simple, but remember, this is undocumented stuff.

Let's look at the code:

unit main;

interface

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

type
TForm1 = class(TForm)
RadioGroup1: TRadioGroup;
procedure FormCreate(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
private
{ Private declarations }
OldItemIndex : Integer;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
OldItemIndex := -1;
end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
with RadioGroup1 do begin
{if there was a previously set item, change it back to the
default appearance first.}
if (OldItemIndex > -1) then
with (Components[OldItemIndex] as TRadioButton) do begin
Color := clBtnFace;
Font.Color := clBtnFace;
Font.Style := [];
end;

{Now with the currently selected item, change its appearance.}
with (Components[ItemIndex] as TRadioButton) do begin
Color := clBlue;
Font.Color := clWhite;
Font.Style := [fsBold];
OldItemIndex := ItemIndex;
end;

end;

end;

The unit code above depicts a simple form with a single TRadioGroup dropped on it. I filled the group up with about 20 values by hand for testing. Now what goes on is pretty straightforward. I have defined a private variable called OldItemIndex that holds the value of a previously selected item. This is a "just in case" thing in that if users change their mind about a selection, they can go back to the radio group, change the value, and the old item will revert back to its original appearance. The code is listed in the OnClick handler for RadioGroup1 above.

Granted, this was pretty simple. You could do more with the TRadioButton if you wish. In fact, all the properties of TRadioButton are available. But as I said before, this is undocumented material, so use at your own risk, even if it's for a purpose as innocuous as this.

Reading and writing text files

How do I read from and write to text files using Delphi?

Note: There's a demonstration program accompanying this article.

One of the most basic operations in practically any language is working with text files. I realize this is probably old hat to many of the more experienced programmers out there, but there are a lot of novice Delphi programmers who don't know how to work with text files at all. Several people have asked me how to open, read, and write text files, so in response to their queries, I've decided to write a quick article on the subject.

In particular, people have asked me how to read a text file into a TMemo, then write its contents back to the file. The easy way to do this is with the TMemo's Lines property LoadFromFile and SaveToFile methods. Just provide a file name and poof! the file's loaded into a memo. Here are a couple of quick functions that I use to read text files into a TMemo (or any component that has a property of type TStrings).

{This procedure loads any TStrings type property with the contents
of a text file}
procedure TextToTStrings(const List : TStrings; const FileName : String);
begin
with List do begin
Clear;
LoadFromFile(FileName);
end;
end;

{This procedure saves the contents of any TStrings type property to a
text file}
procedure TStringsToText(const List : TStrings; const FileName : String);
begin
with List do
SaveToFile(FileName);
end;

As you can see, the procedures are practically one-liners. While they don't seem too interesting, there is one thing about them that you should note. If you look at the code above, the first formal parameter of each of the procedures, const List : TStrings, is a TStrings type passed as a const. This is the only way you can pass a TStrings type as a formal parameter into a function or procedure. You can't pass by reference (passing by var); you'll get a compiler error. This is because unlike a variable that is of a standard type such as String or Integer, a TStrings type variable is actually an instance which, in effect, makes it a constant object. Thus, in order to use it as a formal parameter, you have to pass it as a const. Okay, onward ho!

The two functions above, while useful, didn't really serve to answer the question, though they are the way to quickly and easily load from and save to text files using TMemos. Why did I go that route in the first place? Primarily because most people have asked me that question within the context of a TMemo, so I thought I'd tackle that problem first and foremost, then get down to basic text file I/O.

Working with text files

Delphi provides an incredibly easy way to write a program that reads and writes a text file. To do this, you perform five basic steps:

1. Declare a variable of type TextFile or System.Text
2. Assign a physical text file to the variable
3. Open the file within a specific file mode context
4. Read and write to the file as appropriate
5. Close the file

The first thing you do is declare a text file variable as follows:

var
txt : TextFile;

However, System.Text is just as valid. If you do it this way though, you have to always qualify the word Text with the unit identifier System because a form's unit already contains a Text variable, so you have to point the variable declaration to the proper place. Personally, I find that simply declaring a text file variable as TextFile avoids this problem entirely. I suggest using it instead.

After you've declared the text file, you have to assign the variable to a text file. This is done as follows:

AssignFile(txt, 'MyText.TXT');

Similarly to declaring a text file variable, you can also do a System.Assign(txt, 'MyText.TXT');. But for the same reason I explained above, it's better to use AssignFile. Finally, you have to decide how you want to manipulate the text file. This is done using one of the following three file-opening functions:
Rewrite This creates a file or overwrites an existing file.
Reset This opens an existing file.
Append This opens an existing file, but allows you to append strings to the end of it as well.

Once you've opened the file, you're ready to perform reads and writes. Using the example I outlined above, I'll show you how to read from a text file into a TMemo and write to a text file from a TMemo.

Let's look at reading a text file first. The following procedures, IterTextToTStrings and IterTStringsToText, produce the exact same results as above, but use file I/O functions instead. I've preceded their names with the prefix Iter- to indicate that these procedures employ an iterative methodology for loading in the lines of a text file. Let's look at the code:

{Procedure to read a text file into a TMemo}
procedure IterTextToTStrings(Wnd : THandle; const List : TStrings;
const FileName : String);
var
txt : TextFile;
buf : String;
begin
AssignFile(txt, FileName);
Reset(txt);
List.Clear;
{Do a LockWindowUpdate to delay the screen updates while the
lines are being added. This will prevent visible scrolling
during the process.}
LockWindowUpdate(Wnd);
while NOT EOF(txt) do begin
ReadLn(txt, buf);
List.Add(buf);
end;
LockWindowUpdate(0);
CloseFile(txt);
end;

{Procedure to write a TMemo's contents to a file}
procedure IterTStringsToText(const List : TStrings; const FileName : String);
var
txt : TextFile;
I : Integer;
begin
if FileExists(FileName) then
if (MessageDlg('File ' + FileName + ' exists. Overwrite?', mtConfirmation,
[mbOk, mbCancel], 0) = mrCancel) then
Exit;

AssignFile(txt, FileName);
Rewrite(txt);
for I := 0 to (List.Count - 1) do begin
WriteLn(txt, List[I]);
end;
CloseFile(txt);
end;

I've put in boldface the file operation you should pay attention to in each of the procedures. In the first procedure, I've employed the ReadLn function that reads a line from a text file, then performs a line feed to point the file to the next line. ReadLn takes two parameters: the text file variable, and a String variable for receiving the current line's contents. Note that once you've loaded a line into a string variable, you can do everything to it that you can do to a string. In our case, we load it as a line of a TMemo.

In the second procedure, I've used the WriteLn function to write a line of text to a file. Like ReadLn above, WriteLn takes two parameters: the text file variable, and a valid string. If you don't have a properly filled string, you will probably get some weird results.

After the procedures above finish their basic I/O functions, CloseFile is called to close the file. This step is absolutely imperative. If you don't perform it, you'll get a file sharing violation error when you try to access this file - and that's from any program besides your own. So never forget this step!

There's an issue you should know about that concerns text files: You can't insert a line of text in the middle of an open text file, at least not very easily. You have three options: Create a new file, open an existing file, or append to an existing file. If you really need to insert a line, your best bet is to read the entire file as a an untyped or binary file into a dynamic array or a TList, insert the new line in the appropriate position, then write the entire contents of the array or list back out to the file. Needless to say, this is problematic at best.

Summing it up

What I've presented here is a very basic method of working with text files. However, the principle defined by the five steps I listed above is a constant. It's what you put in between the read and write operation that will make your program complex. In other words, from program to program, text file operations don't change.

Getting and Monitoring Caps Lock Status

How can I display the the current status of the CAPS LOCK key in my application?

There are several ways to address this, and one I have seen before is to check the KeyPress event, and modify the status according to each press of the CapsLock key. The problem with this approach is that it would not give you the necessary status at the time the application started. We therefore have to get our hands dirty to get the ideal solution, and dig into the Windows API. Luckily, the code is quite simple.

We use the GetKeyState function, passing it the CapsLock key constant and receiving a return value. If the return value is zero, CapsLock is off, otherwise it is on. Simple code then, dropped into a button click event:

procedure TForm1.Button1Click(Sender: TObject);
begin
if GetKeyState(VK_CAPITAL) > 0 then
Label1.Caption := 'Caps Lock On'
else
Label1.Caption := 'Caps Lock Off';
end;

Naturally this could easily be modified into a usable function to return the value so that it could be used by more than one routine and avoid code duplication. Firstly, modify it to return the integer status:

function GetCapsLockStatus: Integer;
begin
Result := GetKeyState(VK_CAPITAL);
end;

You would call this from wherever you wanted, and one possible use would achieve the same thing as the original code:

procedure TForm1.Button1Click(Sender: TObject);
begin
if GetCapsLockStatus > 0 then
Label1.Caption := 'Caps Lock On'
else
Label1.Caption := 'Caps Lock Off';
end;

You could also convert it to a function that returns a string:

function GetCapsLockStatusString: Integer;
begin
if GetCapsLockStatus > 0 then
Result := 'On'
else
Result := 'Off';
end;

Usage of this would be simple, assigning the resulting string directly to a label caption:

procedure TForm1.Button2Click(Sender: TObject);
begin
Label1.Caption := GetCapsLockStatusString;
end;

Once you have the original status you can either monitor keypresses for the CapsLock key (check for the virtual key constant VK_CAPITAL) and change the caption appropriately, or simply insert the call into a routine that is regularly called. Note that inserting the function call into the OnKeyPress event would work, but there would be consequences in the performance hit caused by the function running and the label being rewritten every time any key is pressed.

There we go then - simple but effective use of the Windows API to achieve the desired result.

Disabling The System Keys from Your Application

When my application is running, I'd like to prevent users from using Ctrl-Alt-Del and Alt-Tab. What's the best way to do this?

This is pretty quick one... The best way I've seen yet is to trick Windows into thinking that a screen saver is running. When Windows thinks a screensaver is active, Ctrl-Alt-Del and Alt-Tab (Win95 only for this) are disabled. You can perform this trickery by calling a WinAPI function, SystemParametersInfo. For a more in-depth discussion about what this function does, I encourage you to refer to the online help.

In any case, SystemParametersInfo takes four parameters. Here's its C declaration from the Windows help file:

BOOL SystemParametersInfo(
UINT uiAction, // system parameter to query or set
UINT uiParam, // depends on action to be taken
PVOID pvParam, // depends on action to be taken
UINT fWinIni // user profile update flag
);

For our purposes we'll set uiAction to SPI_SCREENSAVERRUNNING, uiParam to 1 or 0 (1 to disable the keys, 0 to re-enable them), pvParam to a "dummy" pointer address, then fWinIni to 0. Pretty straight-forward. Here's what you do:

To disable the keystrokes, write this:

SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @ptr, 0);

To enable the keystrokes, write this:

SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, @ptr, 0);

Not much to it, is there? Thanks to the folks on the Borland Forums for providing this information!

Disabling the Windows Screen Saver at Runtime

I've written an application that runs for several hours, and I found that when the Windows screen saver activates, it seriously affects the performance of my application. Since I'm going to be deploying the application to users, having them manually disable the screen saver is out of the question. Can I possibly disable it while my program is running?

Good question, and yes you can disable the Windows screen saver at runtime. It just so happens that just before Windows activates its screen saver, it sends out a SC_SCREENSAVE message to all running programs. If any of them set the message's Result field to -1, the screen saver won't be activated. So now the problem lies with trapping the message itself.

Since SC_SCREENSAVE is a system message, the best way to trap it is by writing a custom message handler for the WM_SYSCOMMAND message. It can be argued that you can just trap the message in the WndProc handler, but why go so low-level? Oh well, let's continue....

To create the custom message handler for WM_SYSCOMMAND, we need to make a declaration for it in the private section of our code, then write a few simple lines to handle the SC_SCREENSAVE message. Here's the code:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
private
procedure WMSysCommand(var Msg : TWMSysCommand);
message WM_SYSCOMMAND;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMSysCommand(var Msg : TWMSysCommand);
begin
//trap the message and set its result to -1
if (Msg.CmdType = SC_SCREENSAVE) then
Msg.Result := -1
else
inherited;
end;

end.

Notice the declaration of the procedure in the private section. You can actually name the handler anything you want. But by convention, you name your procedure to closest approximation of the message that you're handling; thus the name WMSysCommand.

In the procedure itself, notice as well that unlike most other handlers, the inherited message is not called first. The reason should be obvious - if we called it first, the Result type would remain unchanged. Thus, we subject the cmdType parameter of Msg to a conditional statement to evaluate it prior to taking any action.

The net result of all this? While you're program is running, the Windows Screen saver will not activate. Have fun!

How to force a drop-down combo to drop its list down

How can I force a drop-down combo to drop its list down?

This is done by using a Windows message called CB_SHOWDROPDOWN.

I recommend that you look in the WinAPI help under messages to see what else you can do with them.

The nice thing about messaging in Windows is that the calls are all handled through the Windows API SendMessage routine, which requires four parameters:

1. Parameters of SendMessage function
2. Window Handle (can be an object handle)
3. Message — specifies the message to be sent (in our case, CB_SHOWDROPDOWN)
4. wParam, a 16-bit message-dependent parameter
5. lParam, a 32-bit message-dependent parameter (see WinHelp for specifics on what goes into wParam and lParam)

The gist of this is that Windows messages are performed in a very standard way, so if you haven't done them much, I encourage you to investigate ways to employ them in your code.

To get a combo-box list to automatically drop down when you enter it, put the following code into the OnEnter event:

procedure TForm1.ComboBox1Enter(Sender: TObject);
begin
SendMessage(ComboBox1.handle, CB_SHOWDROPDOWN, Integer(True), 0);
end;

Likewise, you can close the drop-down when you exit by putting the following code into the OnExit event of the combo box:

procedure TForm1.ComboBox1Exit(Sender: TObject);
begin
SendMessage(ComboBox1.handle, CB_SHOWDROPDOWN, Integer(False), 0);
end;

This is probably how the Intuit guys did it with Quicken. So go for it!

Preventing a Form from Re-sizing

How can I keep a form from resizing at runtime?

There are some cases in your development where you want to prevent your users from re-sizing a form. This is especially true if you want a form to behave similarly to a dialog box, but want to maintain the look of a regular window without building the form as a dialog box. True, you can easily set the form's BorderStyle property to bsSingle, but to me, that type of border style looks flat and plain. Not too exciting.

The example I have below employs a Windows message called WM_GETMINMAXINFO. It's a message that is sent to a window when its size or position is about to change. And it can also be used to override a window's default maximized size and position. It can also override the window's default minimum or maximum tracking size (that is, when the user tries to resize the form using the mouse), thus restricting window sizing at runtime. Let's look at the code...

unit Unit1;

interface

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

type
TForm1 = class(TForm)
private
{ Private declarations }
procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
begin
inherited;
with Msg.MinMaxInfo^ do begin
ptMinTrackSize.x:= Form1.width;
ptMaxTrackSize.x:= Form1.width;
ptMinTrackSize.y:= Form1.height;
ptMaxTrackSize.y:= Form1.height;
end;
end;

end.

In the private section of our code, we make the procedure declaration for our message handler. Notice the message WM_GETMINMAXINFO. This tells the compiler that with the preceding procedure, we're trapping the WM_GETMINMAXINFO message. This actually allows us to name the procedure anything we want so we could make the declaration of the procedure GetWinMinMaxInformation(var Msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO. But by convention, message handlers have names that as closely as possible approximate the name of their prospective windows messages.

Looking at the message-handling code itself, we first make a call to the inherited WMGetMinMaxInfo handler. Next, we set the x and y values of the tracking size fields of the message structure to the default width and height of the form. Maybe we should look at the structure itself. The WMGetMinMaxInfo message has a single parameter called MinMaxInfo, which is a structure defined as follows:

typedef struct tagMINMAXINFO { // mmi

POINT ptReserved;

POINT ptMaxSize;

POINT ptMaxPosition;

POINT ptMinTrackSize;

POINT ptMaxTrackSize;

} MINMAXINFO;

In ObjectPascal, this would be a record with five TPoint fields. What we did above was set the ptMin and ptMaxTrackSize fields to the size of the form. However, as you can see in the structure, we can even mess around with the ptMaxSize and ptMaxPosition fields. But that's beyond the scope of this discussion.

If you think about it, this was actually a very simple thing to do. Unfortunately, with Windows, a lot of really simple things are hidden behind a veil of complexity that requires pushing through to get at what you want. In any case, have fun with the code!

Set the System Date and Time in Delphi

How can I set the System Date and Time in Delphi 2.0 (setdate or settime does not exist)?

Use the WinAPI call SetSystemTime. This will allow you to change the system time for the machine you're on. You can find a description of the call in the Win32 help file. Just do a search on SetSystemTime, and you'll get a pretty good discussion of the function.

TFileStream: Saving List Box Data at Runtime

How do I save data entered in a list box at run time without resorting to a text file or having to deal with the overhead of a table?

---

Note:A sample program is available. Even though this article focuses on saving a list box at runtime, it really presents a general overview of using the TFileStream class for streaming components to and from disk. This is an important distinction to make because while I use the TListBox as an example, it is possible to apply the concepts to almost all components.

Any OOP class library worth its salt supports what is called streamable persistent objects. Simply put, this means that an instance of a class (or at least its data) can be saved to a disk file and restored later. When a program reloads the object, it is restored in its last state, just prior to being written. The cool thing about this is that the program doesn't have to have any advance knowledge of the state of the object; the object itself contains all the information it needs to recreate itself when it's restored.
For example, let's say you've created a program that has a list box in which people append various bits of information at run time. For many folks, saving the information to disk means iterating through all the items in the list and writing them to a text file or even a table. The program must reload the data from the external file and add the data, line by line. This is not so bad, but it can be a bit of a chore to write the code.
On the other hand, using object persistence, the same program mentioned above instructs the list box to write its data to a disk file of some sort. When it wants to reload the object, all it has to do is stream it back into memory and specify the base class to write to. Remember, since all the data of the object was saved with it when it was written to disk, the object comes back to life in its original form. That's the whole idea behind object persistence.
Delphi itself makes heavy use of object persistence. Every time you save a project, it streams out to disk the data contained in your objects' properties so that everything you set during your session is saved. When you reload a project, Delphi streams the object data back into your form(s) to restore everything you previously set. In fact, a form file itself is streamed to and from disk. I should note here that Delphi uses a couple of specialized stream classes, TWriter and TReader which are derived from a superclass called TFiler. I won't go into the details of these classes here, since I'm providing a much simpler demonstration of employing object persistence in your programs. I'll leave it up to you to research this topic further.
Moving on, you might ask, "Where does employing streamable persistent objects come in handy?" The most useful cases I've found for employing them are when I've written programs that provide parameter or input criteria for processes, where the range of possible values to search on remain fairly constant from one run of the program to the next.
For instance, in my line of work, almost all of my programs are typically front-ends to very complex query operations. However, the range of domains and their values don't change very often, and from client to client, the same questions are typically asked. So in these cases, I've found that simply streaming my criteria objects (these are all list objects) out to disk when I close the forms and streaming them back in when I open the forms provides a much cleaner solution to saving my criteria sets from session to session. Besides, this is very low overhead programming, since once the programs are finished with the streams, they're immediately destroyed. Not only that, I don't have to use DB.PAS or DBTables.PAS for data operations.

A simple example

The example I've provided here is by no means a full-fledged search program of the type I normally write. I've merely taken the parts pertinent to this article for your use. Feel free to include or modify this code to your heart's content. In any case, here's the code listing for the main form of the program. We'll discuss particulars below.

unit main;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Edit1: TEdit;
    Memo1: TMemo;
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ListBox1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then begin
    Key := #0;
    ListBox1.Items.Add(Edit1.Text);
    Edit1.Text := '';
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  strm : TFileStream;
begin
  if FileExists('MyList.DAT') then begin
    strm := TFileStream.Create('MyList.DAT', fmOpenRead);
    strm.ReadComponent(ListBox1);
    strm.Free;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  strm : TFileStream;
begin
  strm := TFileStream.Create('MyList.DAT', fmCreate);
  strm.WriteComponent(ListBox1);
  strm.Free;
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
  ListBox1.Items.Delete(ListBox1.ItemIndex);
end;

end.

You were expecting some complex code, weren't you? In actuality, this stuff is incredibly simple. So why isn't it documented very well? I'd say it's because this is one of the more uncommon things done in Delphi. But for those of you who wish to really get into the innards of the environment, this stuff is a must to understand and master. Let's look a little deeper into the code.
The program consists of a form with a TEdit and a TListBox dropped onto it. It has just two meaningful methods: FormCreate and FormClose. In the FormCreate method,

procedure TForm1.FormCreate(Sender: TObject);
var
  strm : TFileStream;
begin
  if FileExists('MyList.DAT') then begin
    strm := TFileStream.Create('MyList.DAT', fmOpenRead);
    strm.ReadComponent(ListBox1);
    strm.Free;
  end;
end;

the program checks for the existence of MyList.DAT with a call to FileExists, which is the stream file that holds the list box information. If it exists, the file is streamed into ListBox1; otherwise, it does nothing. With the FormClose method,

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  strm : TFileStream;
begin
  strm := TFileStream.Create('MyList.DAT', fmCreate);
  strm.WriteComponent(ListBox1);
  strm.Free;
end;

the program writes ListBox1 out to MyList.DAT, overwriting any previous versions of the file.
That's all there is to this program. Surprisingly, this is one of the more simple things to do in Delphi, but paradoxically it's one of the most difficult things to find good information about in the manuals or help file. Granted, as I mentioned above, doing this type of stuff is fairly uncommon, but think of the implication: simple, low overhead, persistent storage without the need for tables. What was accomplished above was done in fewer than 10 lines of code — that's absolutely incredible!
I urge you to play around with this technique and apply it to other things. I think you'll get a lot of mileage out of it.

Copying Files in Delphi: Using Streams

I'd like to be able to copy files in Delphi, but am having trouble figuring out how to do it. I've been using operating system level calls, but don't want to limited by them. Is there a way to do it in Delphi?

This is one of those topics that I've gotten asked about frequently enough that I decided it's time to write a short article on how to do it. It's funny that something as basic as this is not as visible as might be expected. It falls into a category that I call, "You gotta know what you're looking for..." Essentially, it means that the technique may not be hard to implement, it's just hard to find. In any case, once you know how to do it, it's not that difficult at all.

There are actually a number of ways to copy files. One way is to use untyped files along with BlockRead and BlockWrite. This also entails the use of an intermediary buffer. It works, but it can be a bit unwieldy, especially for novices. An easier way to accomplish file copying in Delphi is to use streams. As the term implies, a stream is sequential stream of data. When copying a file, you stream the file into a buffer, then stream buffer out to another file. Pretty simple in concept. Now in Delphi there are several types of streams which descend from the abstract base class TStream. I encourage you to look them up in the online help since they are beyond the scope of this discussion. But for our purposes, the descendant class that we're interested in is called TFileStream. This class allows applications to read from and write to files on disk. For simplicity's sake, I won't be going into the various intricacies of the class; again, encouraging you to study the online help. Or better yet, Ray Lischner's Book Secrets of Delphi 2 has a great discussion about streams as well (don't worry, the material applies to Delphi 3).

Quick and Dirty File Copying

The easiest method of copying a file with streams is called stream to stream copying. Essentially, this method involves creating a stream for the source file, and creating one for the destination file. Once that's done, it's a simple matter of copying the contents of the source stream to the destination stream. Listing 1 below shows a procedure that encapsulates stream to stream copying:

{Quick and dirty stream copy}
procedure FileCopy(const FSrc, FDst: string);
var
sStream,
dStream: TFileStream;
begin
sStream := TFileStream.Create(FSrc, fmOpenRead);
try
dStream := TFileStream.Create(FDst, fmCreate);
try
{Forget about block reads and writes, just copy
the whole darn thing.}
dStream.CopyFrom(sStream, 0);
finally
dStream.Free;
end;
finally
sStream.Free;
end;
end;

Undoubtedly, you can get a lot more sophisticated with this. But for now, we'll leave it at this...

How to Create a Table at Runtime

I was a VB programmer, until my recent shift to Delphi 2.0. How can I create a database in code?

---

It depends on the type of database you want to build. However, I can show you how to do it with a Paradox table. Conceivably, it stands to reason that since the TTable is database-independent and if you've got the right settings in the BDE, you should be able to create a table with the TTable component in any database. This is not necessarily true. SQL tables are normally created using the SQL call CREATE TABLE. And each server has its own conventions for creating tables and defining fields. So it's important to note this if you're working with a SQL database. The problem is that SQL databases support different data types that aren't necessarily available in the standard BDE set. For instance, MS SQL server's NUMERIC data format is not necessarily a FLOAT as it's defined in the BDE. So your best bet would probably be to create SQL tables using SQL calls.
What you have to do is declare a TTable variable, create an instance, then with the TTable's FieldDefs property, add field definitions. Finally, you'll make a call to CreateTable, and your table will be created. Here's some example code:

{ "Add" is the operative function here.
  Add(const Name: string; DataType: TFieldType; Size: Word; Required: Boolean);
}
procedure CreateATable(DBName,            //Alias or path
                       TblName : String); //Table Name to Create
var
  tbl : TTable;
begin
  tbl := TTable.Create(Application);
  with tbl do begin
    Active := False;
    DatabaseName := DBName;
    TableName := TblName;
    TableType := ttParadox;
    with FieldDefs do begin
      Clear;
      Add('LastName', ftString, 30, False);
      Add('FirstName', ftString, 30, False);
      Add('Address1', ftString, 40, False);
      Add('Address2', ftString, 40, False);
      Add('City', ftString, 30, False);
      Add('ST', ftString, 2, False);
      Add('Zip', ftString, 10, False);
    end;

    {Add a Primary Key to the table}
    with IndexDefs do begin
      Clear;
      Add('Field1Index', 'LastName;FirstName', [ixPrimary, ixUnique]);
    end;
    
    CreateTable; {Make the table}
  end;
end;

The procedure above makes a simple contact table, first by defining the fields to be included in the table, then creating a primary key. As you can see, it's a pretty straightforward procedure. One thing you can do is to change the TableType property setting to a variable that's passed as a parameter to the procedure so you can create DBase or even ASCII tables. Here's snippet of how you'd accomplish that:

procedure CreateATable(DBName,                //Alias or path
                       TblName : String);     //Table Name to Create
                       TblType : TTableType); //ttDefault, ttParadox, ttDBase, ttASCII
var
  tbl : TTable;
begin
  tbl := TTable.Create(Application);
  with tbl do begin
    Active := False;
    DatabaseName := DBName;
    TableName := TblName;
    TableType := TblType;
    with FieldDefs do begin
      Clear;
      Add('LastName', ftString, 30, False);
      Add('FirstName', ftString, 30, False);
      Add('Address1', ftString, 40, False);
      Add('Address2', ftString, 40, False);
      Add('City', ftString, 30, False);
      Add('ST', ftString, 2, False);
      Add('Zip', ftString, 10, False);
    end;

    {Add a Primary Key to the table}
    with IndexDefs do begin
      Clear;
      Add('Field1Index', 'LastName;FirstName', [ixPrimary, ixUnique]);
    end;
    
    CreateTable; {Make the table}
  end;
end;

Pretty simple, right? One thing you should note is that the TableType property is only used for desktop databases. It doesn't apply to SQL tables.
Oh well, that's it in a nutshell. Have fun!

How can I put a button on a form's caption bar?

I've seen some programs that add text or buttons on the title bar of a form. How can I do this in Delphi?

I got my first insight into solving this problem when I wrote a previous tip that covered rolling up the client area of forms so that only the caption bar showed. In my research for that tip, I came across the WMSetText message that is used for drawing on a form's canvas. I wrote a sample application to test drawing in the caption area. The only problem with my original code was that the button would disappear when I resized or moved the form.

I turned to Delphi/Pascal guru Neil Rubenking for help. He pointed me in the direction of his book, Delphi Programming Problem Solver, which contains an example for doing this exact thing. The code below is an adaptation of the example in his book. The most fundamental difference between our examples is that I wanted to make a speedbutton with a bitmap glyph, and Neil actually drew a shape directly on the canvas. He also placed the button created in 16-bit Delphi on the left-hand side of the frame, and Win32 button placement was on the right. I wanted my buttons to be placed on the right for both versions, so I wrote appropriate code to handle that. The deficiency in my code was the lack of handlers for activation and painting in the non-client area of the form.

One thing I'm continually discovering is that there is a very definitive structure in Windows &mdash a definite hierarchy of functions. I've realized that the thing that makes Windows programming at the API level difficult is the sheer number of functions in the API set. For those who are reluctant to dive into the WinAPI, think in terms of categories first, then narrow your search. You'll find that doing it this way will make your life much easier.

What makes all of this work is Windows messages. The messages we're interested in here are not the usual Windows messages handled by plain-vanilla Windows apps, but are specific to an area of a window called the non-client area. The client area of a window is the part inside the border where most applications present information. The non-client area consists of the window's borders, caption bar, system menu and sizing buttons. The Windows messages that pertain to this area have the naming convention of WM_NCMessageType. Taking the name apart, 'WM' stands for Windows Message, 'NC' stands for Non-client area, and MessageType is the type of message being trapped. For example, WM_NCPaint is the paint message for the non-client area. Taking into account the hierarchical and categorical nature of the Windows API, nomenclature is a very big part of it; especially with Windows messages. If you look in the help file under messages, peruse through the list of messages and you will see the order that is followed.

Let's look at a list of things that we need to consider to add a button to the title bar of a form:

1. We need to have a function to draw the button.
2. We'll have to trap drawing and painting events so that our button stays visible when the form activates, resizes or moves.
3. We're dropping a button on the title bar, so we have to have a way of trapping for a mouse click on the button.

I'll now discuss these topics, in the above order.

Drawing a TRect as a Button

You can't drop VCL objects onto a non-client area of a window, but you can draw on it and simulate the appearance of a button. In order to perform drawing in the title bar of a window, you have to do three very important things, in order:

1. You must get the current measurements of the window and the size of the frame bitmaps so you know what area to draw in and how big to draw the rectangle.
2. Then you have to define a TRect structure with the proper size and position within the title bar.
3. Finally, you have to draw the TRect to appear as a button, then add any glyphs or text you might want to draw to the buttonface.

All of this is accomplished in a single call. For this program we make a call to the DrawTitleButtonprocedure, which is listed below:

procedure TTitleBtnForm.DrawTitleButton;
var
bmap : TBitmap; {Bitmap to be drawn - 16 X 16 : 16 Colors}
XFrame, {X and Y size of Sizeable area of Frame}
YFrame,
XTtlBit, {X and Y size of Bitmaps in caption}
YTtlBit : Integer;
begin
{Get size of form frame and bitmaps in title bar}
XFrame := GetSystemMetrics(SM_CXFRAME);
YFrame := GetSystemMetrics(SM_CYFRAME);
XTtlBit := GetSystemMetrics(SM_CXSIZE);
YTtlBit := GetSystemMetrics(SM_CYSIZE);

{$IFNDEF WIN32}
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),
YFrame - 1,
XTtlBit + 2,
YTtlBit + 2);

{$ELSE} {Delphi 2.0 positioning}
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),
YFrame - 1,
XTtlBit + 2,
YTtlBit + 2)
else
TitleButton := Bounds(Width - XFrame - 4*XTtlBit + 2,
XFrame + 2,
XTtlBit + 2,
YTtlBit + 2);
{$ENDIF}


Canvas.Handle := GetWindowDC(Self.Handle); {Get Device context for drawing}
try
{Draw a button face on the TRect}
DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, False, False, False);
bmap := TBitmap.Create;
bmap.LoadFromFile('help.bmp');
with TitleButton do
{$IFNDEF WIN32}
Canvas.Draw(Left + 2, Top + 2, bmap);
{$ELSE}
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
Canvas.Draw(Left + 2, Top + 2, bmap)
else
Canvas.StretchDraw(TitleButton, bmap);
{$ENDIF}

finally
ReleaseDC(Self.Handle, Canvas.Handle);
bmap.Free;
Canvas.Handle := 0;
end;
end;

Step 1 above is accomplished by making four calls to the WinAPI function GetSystemMetrics, asking the system for the width and height of the window that can be sized (SM_CXFRAME and SM_CYFRAME), and the size of the bitmaps contained on the title bar (SM_CXSIZE and SM_CYSIZE).

Step 2 is performed with the Bounds function, which returns a TRect defined by the size and position parameters that are supplied to it. Notice that I used some conditional compiler directives here. This is because the size of the title bar buttons in Windows 95 and Windows 3.1 are different, so they have to be sized differently. And since I wanted to be able to compile this in either version of Windows, I used a test for the predefined symbol, WIN32, to see which version of Windows the program is compiled under. However, since the Windows NT UI is the same as Windows 3.1, it's necessary to grab further version information under the Win32 conditional to see if the Windows version is Windows NT. If so, we define the TRect to be just like the Windows 3.1 TRect.

To perform Step 3, we make a call to the Buttons unit's DrawButtonFace to draw button features within the TRect that we defined. As added treat, I included code to draw a bitmap in the button. You'll see that I used a conditional compiler directive to draw the bitmap under different versions of Windows. I did this because the bitmap I used was 16x16 pixels, which might be too big for Win95 buttons. So I used StretchDraw under Win32 to stretch the bitmap to the size of the button.

Trapping the Drawing and Painting Events

You must make sure that the button will stay visible every time the form repaints itself. Painting occurs in response to activation and resizing, which fire off paint and text setting messages that will redraw the form. If you don't have a facility to redraw your button, you'll lose it every time a repaint occurs. So what we have to do is write event handlers which will perform their default actions and redraw our button when they fire off. The following four procedures handle the paint triggering and painting events:

{Paint triggering events}
procedure TForm1.WMNCActivate(var Msg : TWMNCActivate);
begin
Inherited;
DrawTitleButton;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
Perform(WM_NCACTIVATE, Word(Active), 0);
end;

{Painting events}
procedure TForm1.WMNCPaint(var Msg : TWMNCPaint);
begin
Inherited;
DrawTitleButton;
end;

procedure TForm1.WMSetText(var Msg : TWMSetText);
begin
Inherited;
DrawTitleButton;
end;

Every time one of these events fires off, it makes a call to the DrawTitleButton procedure. This will ensure that our button is always visible on the title bar. Notice that we use the default handler OnResize on the form to force it to perform a WM_NCACTIVATE.

Handling Mouse Clicks

Now that we've got code that draws our button and ensures that it's always visible, we have to handle mouse clicks on the button. The way we do this is with two procedures. The first procedure tests to see if the mouse click was in the area of our button, then the second procedure actually performs the code execution associated with our button. Let's look at the code:

{Mouse-related procedures}
procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest);
begin
Inherited;
{Check to see if the mouse was clicked in the area of the button}
with Msg do
if PtInRect(TitleButton, Point(XPos - Left, YPos - Top)) then
Result := htTitleBtn;
end;

procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
begin
inherited;
if (Msg.HitTest = htTitleBtn) then
ShowMessage('You pressed the new button');
end;

The first procedure WMNCHitTest(var Msg : TWMNCHitTest) is a hit tester message to determine where the mouse was clicked in the non-client area. In this procedure we test if the point defined by the message was within the bounds of our TRect by using the PtInRect function. If the mouse click was performed in the TRect, then the result of our message is set to htTitleBtn, which is a constant that was declared as htSizeLast + 1. htSizeLast is a hit test constant generated by hit test events to test where the last hit occurred.

The second procedure is a custom handler for a left mouse click on a button in the non-client area. Here we test if the hit test result was equal to htTitleBtn. If it is, we show a message. You can make any call you choose to at this point.

Putting it All Together

Let's look at the entire code in the form to see how it all works together:

unit Capbtn;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Buttons;

type
TTitleBtnForm = class(TForm)
procedure FormResize(Sender: TObject);
private
TitleButton : TRect;
procedure DrawTitleButton;
{Paint-related messages}
procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;
procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPAINT;
procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;
{Mouse down-related messages}
procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
function GetVerInfo : DWORD;
end;

var
TitleBtnForm: TTitleBtnForm;

const
htTitleBtn = htSizeLast + 1;

implementation
{$R *.DFM}

procedure TTitleBtnForm.DrawTitleButton;
var
bmap : TBitmap; {Bitmap to be drawn - 16 X 16 : 16 Colors}
XFrame, {X and Y size of Sizeable area of Frame}
YFrame,
XTtlBit, {X and Y size of Bitmaps in caption}
YTtlBit : Integer;
begin
{Get size of form frame and bitmaps in title bar}
XFrame := GetSystemMetrics(SM_CXFRAME);
YFrame := GetSystemMetrics(SM_CYFRAME);
XTtlBit := GetSystemMetrics(SM_CXSIZE);
YTtlBit := GetSystemMetrics(SM_CYSIZE);

{$IFNDEF WIN32}
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),
YFrame - 1,
XTtlBit + 2,
YTtlBit + 2);

{$ELSE} {Delphi 2.0 positioning}
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),
YFrame - 1,
XTtlBit + 2,
YTtlBit + 2)
else
TitleButton := Bounds(Width - XFrame - 4*XTtlBit + 2,
XFrame + 2,
XTtlBit + 2,
YTtlBit + 2);
{$ENDIF}


Canvas.Handle := GetWindowDC(Self.Handle); {Get Device context for drawing}
try
{Draw a button face on the TRect}
DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, False, False, False);
bmap := TBitmap.Create;
bmap.LoadFromFile('help.bmp');
with TitleButton do
{$IFNDEF WIN32}
Canvas.Draw(Left + 2, Top + 2, bmap);
{$ELSE}
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
Canvas.Draw(Left + 2, Top + 2, bmap)
else
Canvas.StretchDraw(TitleButton, bmap);
{$ENDIF}

finally
ReleaseDC(Self.Handle, Canvas.Handle);
bmap.Free;
Canvas.Handle := 0;
end;
end;

{Paint triggering events}
procedure TTitleBtnForm.WMNCActivate(var Msg : TWMNCActivate);
begin
Inherited;
DrawTitleButton;
end;

procedure TTitleBtnForm.FormResize(Sender: TObject);
begin
Perform(WM_NCACTIVATE, Word(Active), 0);
end;

{Painting events}
procedure TTitleBtnForm.WMNCPaint(var Msg : TWMNCPaint);
begin
Inherited;
DrawTitleButton;
end;

procedure TTitleBtnForm.WMSetText(var Msg : TWMSetText);
begin
Inherited;
DrawTitleButton;
end;

{Mouse-related procedures}
procedure TTitleBtnForm.WMNCHitTest(var Msg : TWMNCHitTest);
begin
Inherited;
{Check to see if the mouse was clicked in the area of the button}
with Msg do
if PtInRect(TitleButton, Point(XPos - Left, YPos - Top)) then
Result := htTitleBtn;
end;

procedure TTitleBtnForm.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
begin
inherited;
if (Msg.HitTest = htTitleBtn) then
ShowMessage('You pressed the new button');
end;

function TTitleBtnForm.GetVerInfo : DWORD;
var
verInfo : TOSVERSIONINFO;
begin
verInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if GetVersionEx(verInfo) then
Result := verInfo.dwPlatformID;
{Returns:
VER_PLATFORM_WIN32s Win32s on Windows 3.1
VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95
VER_PLATFORM_WIN32_NT Windows NT }
end;

end.

Suggestions for Exploring

You might want to play around with this code a bit to customize it to your own needs. For instance, if you want to add a bigger button, add pixels to the XTtlBit var. You can also mess around with creating a floating toolbar that is purely on the title bar. Also, now that you have a means of interrogating what's going on in the non-client area of the form, you might want to play around with the default actions taken with the other buttons like the System Menu button to perhaps display your own custom menu.

Take heed, though: Playing around with Windows messages can be dangerous. Save your work constantly, and be prepared for some system crashes while you experiment.

Creating a Form Without a Title Bar

How can I create a form that doesn't have a caption, but can be re-sized?

---

As they say, "There's more than one way to skin a cat," and I can't agree more as far as programming is concerned. Let me share a little anecdote with you...Being the "artistic dude" in my company, I'm always in search of new ways to present information to users. I do this by creating non-standard user interfaces (which I find rather boring), spicing them up with graphics and multimedia features. My philosophy centers around this question: Why should information retrieval be a boring task? Well, it shouldn't. And an extension to this question could be: Why do business programs have to all look the same? Well, they don't. So I choose to build "odd" business user interfaces. My latest designs have followed game interfacess that use a plethora of high-resolution graphics and captionless forms (this is where it all kicks in). In the past, I didn't need my forms to move anywhere. But as my interfaces have become more complex, I've had to start providing ways to move them. Unfortunately, the method that I employed in the original article here, didn't account for clicking only in a certain area on a form. You just click and hold the mouse button down anywhere on the form, and the form will move. Unfortunately, that isn't always the best solution. For instance, with one of my forms, I created a "pseudo" caption by aligning a TPanel at the top of the client area of my form. There's a bit more functionality built into the panel, but I wanted it to act very much like a regular caption: a click and drag would drag the form, and a double-click would maximize it. With that in mind, I set about writing the panel's click and drag method using what I originally wrote as a base. It didn't work. So doing a little research and asking a couple of questions around the newsgroups, Kerstin Thaler, a very helpful person, showed me a real cool method for implementing what I needed to do. Here it is: procedure TMainFrm.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); const SC_DRAGMOVE = $F012; begin if Button = mbLeft then begin ReleaseCapture; Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0); end; end; This is such incredibly easy code! Instead of overriding the default NC_HITTEST message handler, I could accomplish form movement from the MouseDown of my panel! Basically, all the method does is send a WM_SYSCOMMAND message to the form with the SC_DRAGMOVE constant to perform a drag move. Kerstin did say, that the $F012 isn't documented. But hey! the method works and it works well. So if you have a captionless form and want to move it by dragging from one of its child components, this is the way to do it!

Many folks would say, "Just set the BorderStyle of the form to bsNone and you'll remove the caption." However, there's a problem with that suggestion: Not only do you lose the caption bar, you lose the entire border, which means you can't resize the form. The only way to get around this is to go behind the scenes in Delphi. Fortunately, it's a relatively simple process.
Delphi is not just ObjectPascal; it is also a very effective wrapper of the Windows API (Don't worry, we won't get into the Windows API too much in this article). In Windows, every window is created using one of two standard functions: CreateWindow and CreateWindowEx. CreateWindow makes a window with standard window styles, while CreateWindowEx is the same as CreateWindow, but you can add extended window styles to the window you want to create. (I encourage you to read through the help file for a thorough discussion of these two API calls since I won't be going into detail with these topics.)
When a form is created in Delphi, a call is made to CreateWindowEx &mdash TForm's Create method is the wrapper function for this call &mdash and Create passes a record structure to CreateWindowsEx through a virtual method of TForm called CreateParams.
CreateParams is a virtual method of TForm. This means you can override it which, in turn, means you can change the default style of a window when it's created to suit your particular needs. For our purposes, we want to eliminate the caption. That's easily done by changing the style bits of the LongInt Style field of the TCreateParams structure, the record that's passed to CreateWindowEx. Look at the code; we'll discuss particulars below:

unit NoCap;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, Buttons, BDE, DB;

type
  TForm1 = class(TForm)
    Button1 : TButton;
    procedure Button1Click(Sender: TObject);
  private
    {Here's what we're overriding}
    procedure CreateParams(VAR Params: TCreateParams); override;
    procedure WMNCHitTest(VAR Msg: TWMNcHitTest); message WM_NCHITTEST;
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.CreateParams(VAR Params: TCreateParams);
begin
  Inherited CreateParams(Params);
  WITH Params DO
    Style := (Style OR WS_POPUP) AND (NOT WS_DLGFRAME);
    {or... Style := Style + WS_POPUP - WS_DLGFRAME; which is the 
     equivalent to the above statement}
 end;

procedure TForm1.WMNCHitTest(var msg: TWMNCHitTest);
begin
  inherited;
  if  (msg.Result = htClient) then
    msg.Result := htCaption;
end;

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

end.

Notice in the line in CreateParams where I set the Style for the form: Style := (Style OR WS_POPUP) AND (NOT WS_DLGFRAME);. My first bit manipulation is Style OR WS_POPUP. This means give me the default style bits and make the window a regular pop-up window with a resizeable border. The second portion says don't include a dialog frame. With respect to this, the WS_DLGFRAME will produce a frame typical of dialog boxes. By masking it out, you remove the title bar. WS_POPUP ensures you have a resizeable border with which to work.
What about the WMNCHitTest message handler? Well, if you have a form with no title bar, you have absolutely no way to move it, because by convention, forms are moved by dragging the title bar. By trapping a mouse hit with the WM_NCHITTEST message and changing the default behavior of the mouse hit, you can allow dragging of the form from the client area.
Read through the Windows API help and look at all the style bits you can set. Play with different combinations to see what you get.