Launching a Program at Windows Startup

Problem/Question/Abstract:

There are a few programs installed on my system that launch when Windows starts, but don't have shortcuts in my Startup folder. Is there some trick that I'm missing here?

Answer:

Solve 1:

Are you kiddin'? That capability isn't clearly documented anywhere? Okay, okay, enough of the facetiousness... In actuality, it is a bit of a trick to get a program to do this (primarily because it's not something that's very well-documented), but it's not trickery of any sort that would prevent you from being able to program this yourself. All it involves is writing to one of two paths in the Windows registry under the HKEY_LOCAL_MACHINE root key:

Software\Microsoft\Windows\CurrentVersion\RunOnce
-or-
Software\Microsoft\Windows\CurrentVersion\Run

As you've probably surmised, writing an entry to the "RunOnce" key will make it so your program only launches after the next shutdown and startup of Windows. Writing an entry to the "Run" key will make your program launch each time Windows is started.

Here's a quick procedure that'll do either action for you. We'll discuss it after I list the code:

{=====================================================================
The following procedure instructs Windows at startup to execute your
program. Here's a summary of the formal params:

WindowTitle  : Title of the Window of your program. Note that this is
                actually a superfluous parameter, and can be any value
                you want. But for convention's sake, and because the
                registry entry expects a value, you have to provide it.

CommandLn    : This is the fully qualified path and executable name of
                your program (e.g. 'C:\MyProgams\MyProgam.exe.' If you
                have any command line parameters, you include them in
                this string as well.

RunOnlyOnce  : Setting this to true makes the program only launch just
                once after you write to the registry. Once it's launched,
                Windows will delete its entry from the Run path in the
                registry. Set it to False if you want your program to
                always launch when Windows starts up.
=====================================================================}

procedure RunOnStartup(WindowTitle,
  CommandLn: string;
  RunOnlyOnce: Boolean);
var
  RegIniFile: TRegIniFile;
begin
  RegIniFile := TRegIniFile.Create('');
  with RegIniFile do
  begin
    RootKey := HKEY_LOCAL_MACHINE;
    if RunOnlyOnce then
      RegIniFile.WriteString('Software\Microsoft\Windows\' +
        'CurrentVersion\RunOnce'#0,
        WindowTitle, CommandLn)
    else
      RegIniFile.WriteString('Software\Microsoft\Windows\' +
        'CurrentVersion\Run'#0,
        WindowTitle, CommandLn);
    Free;
  end;
end;

Notice that the RegIniFile instance variable above is of type TRegIniFile, as opposed to TRegistry. TRegIniFile is a descendant class of TRegistry and inherits all its methods and properties. And in addition to all that, it adds comparable methods of TIniFile, the tried and true Windows 3.1 class. This allows us to treat the registry like an INI file, which is far easier to work with than accessing the registry through TRegistry. This is one of the things I just love about Delphi! Want to make it simple? Subclass and extend a class' functionality!

Employing the Procedure

So where should you employ this? The most likely place is to use the procedure with system tray applications that you always want to run when Windows starts up. Personally, I make a call to the function in the OnClose  event of the main form of my application. That way, I always know that even if Windows is shutdown, my program will make sure that its Run or RunOnce entry is written to the Registry.

Another place you might want to use this procedure is with readme or help files that accompany a program that you install on another computer, ala Microsoft Intellipoint Mouse help...


Solve 2:

uses Registry;

procedure SetAutoStart(AppName, AppTitle: string; registerit: boolean);
const
  RegKey = '\Software\Microsoft\Windows\CurrentVersion\Run';
  // or: RegKey = '\Software\Microsoft\Windows\CurrentVersion\RunOnce';
var
  Registry: TRegistry;
begin
  Registry := TRegistry.Create;
  try
    Registry.RootKey := HKEY_CURRENT_USER;
    if Registry.OpenKey(RegKey, False) then
    begin
      if registerit = false then
        Registry.DeleteValue(AppTitle)
      else
        Registry.WriteString(AppTitle, AppName);
    end;
  finally
    Registry.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetAutoStart('Your Application Title', ParamStr(0), false);
end;


Solve 3:

One way is placing a direct access to the application in the Startup folder of Windows Start Menu. Alternatively, you can add a value under the appropriate key in the Windows Registry, as shown below:

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetRegistryData(HKEY_LOCAL_MACHINE,
    'Software\Microsoft\Windows\CurrentVersion\Run',
    Application.Title, rdString, Application.ExeName);
end;

NOTE: SetRegistryData has been featured in the article "Accessing the Windows Registry".

Instead of Application.Title you can write a string with a unique name for the application, and instead of Application.ExeName you can write the full path name of the application (as well as its command-line parameters if they are needed).

Add separator lines to your code with a Delphi's Code Templates

Problem/Question/Abstract:

Add separator lines to your code with a Delphi's Code Templates

Answer:

In a source file with many procedures and functions in it, it is often hard to see where a routine starts and ends -- with all the begin and end statements. So you could add a comments line after each procedure, like this:

//------------------------------------------------------------------------

But who has time to draw all these lines? Well, Delphi has an answer to that problem: Code Templates. Just press CTRL + J followed by the shortcut for the template you want, and Delphi automatically writes out the code for you.

If you make a template for a comments separator line and set its shortcut to a symbol such as "-", then it will appear at the top of the list, since the list of code templates is sorted alphabetically. Now, in order to insert a separator line in your code file, all you have to do is press CTRL + J and ENTER.

How to pick from a list of TPanels in a TListBox and display the selected panel

Problem/Question/Abstract:

How to pick from a list of TPanels in a TListBox and display the selected panel

Answer:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure ListBox1Click(Sender: TObject);
  private
    { Private declarations }
    FPanelList: TList;
    FActivePanel: TPanel;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{TForm1}

constructor TForm1.Create(AOwner: TComponent);
var
  i: integer;
  TempPanel: TPanel;
begin
  inherited;
  FPanelList := TList.Create;
  for i := 0 to 20 do
  begin
    TempPanel := TPanel.Create(self);
    TempPanel.Caption := 'TPanel' + IntToStr(i);
    Listbox1.Items.Add(TempPanel.Caption);
    FPanelList.Add(TempPanel);
  end;
end;

destructor TForm1.Destroy;
var
  i: integer;
begin
  for i := FPanelList.Count - 1 downto 0 do
    TPanel(FPanelList[i]).Free;
  FPanelList.Free;
  inherited;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  if FActivePanel <> nil then
    FActivePanel.Parent := nil;
  FActivePanel := FPanelList[ListBox1.ItemIndex];
  FActivePanel.Parent := self;
end;

end.

Convert an INI file to XML

Problem/Question/Abstract:

INI was the old way to store settings (outside the registry), now everything is XML. This routine will convert an INI file into an XML node of a document.

Answer:

An XML node is part of an XML Document.  So if you have a new XMLDocument then just add a single node (AddChild) and that is the DocumentNode, then you could pass the DocumentNode to this routine.  If you pass in different Nodes then you could store multiple INI files in the same XML document, even if they have section and value name collisions.  The AsAttributes parameter determines if the values are stored as Attributes (default) or sub-nodes.  

uses XMLIntf, XMLDoc, INIFiles;

procedure INI2XML(const pINIFileName: string; const pXML: IXMLNode;
  const AsAttributes: Boolean = true);
var
  lINIFile: TIniFile;
  lSections, lItems: TStringList;
  iSections, iItems: integer;
  lNode: IXMLNode;
begin
  lINIFile := TIniFile.Create(pINIFileName);
  try
    lSections := TStringList.Create;
    try
      lItems := TStringList.Create;
      try

        lINIFile.ReadSections(lSections);

        for iSections := 0 to pred(lSections.Count) do
        begin
          lItems.Clear;
          lINIFile.ReadSection(lSections[iSections], lItems);
          lNode := pXML.AddChild(StringReplace(lSections[iSections], ' ', '',
            [rfReplaceAll]));
          for iItems := 0 to pred(lItems.Count) do
          begin
            if AsAttributes then
              lNode.Attributes[lItems[iItems]] :=
                lINIFile.ReadString(lSections[iSections], lItems[iItems], '')
            else
              lNode.AddChild(lItems[iItems]).Text :=
                lINIFile.ReadString(lSections[iSections], lItems[iItems], '');
          end;
          lNode := nil;
        end;

      finally lItems.Free;
      end;
    finally lSections.Free;
    end;
  finally lINIFile.Free;
  end;
end;

How to colour every second row in a TDBGrid green

Problem/Question/Abstract:

I want to make every other row in my TDBGrid green to simulate green bar paper.

Answer:

If you are using a TTable and either dBase or Paradox files, you can use the DataSet.RecNo to track which row is being painted:


procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
  Field: TField; State: TGridDrawState);
const
  clSeaGreen = $00BAFF6F;
var
  OldBrushColor: TColor;
  OddRec: Boolean;
begin
  with TDBGrid(Sender) do
  begin
    OddRec := ((DataSource.DataSet.RecNo mod 2) <> 0);
    with Canvas do
    begin
      OldBrushColor := Brush.Color;
      if (gdSelected in State) then
        Brush.Color := clHighlight
      else if OddRec then
        Brush.Color := clSeaGreen
      else
        Brush.Color := clWhite;
    end;
    Canvas.FillRect(Rect);
    DefaultDrawDataCell(Rect, Field, State);
    Canvas.Brush.Color := OldBrushColor;
  end;
end;

How to force an overlapped or minimized window to the top

Problem/Question/Abstract:

I cannot get my overlapped or minimized window to come to the top by hook or crook. I have tried the SetForegroundWindow, BringToTop and ShowWindow (show, restore) API calls using the form, application and the application.mainform handles. Every combination reacted the same. I get the visual clue of the application blinking on the task bar for about 5 seconds and that's it. It never comes to the top to be viewable. This is a Win98 SE test station.

Answer:

function ForceForegroundWindow(hwnd: THandle): boolean;
const
  SPI_GETFOREGROUNDLOCKTIMEOUT = $2000;
  SPI_SETFOREGROUNDLOCKTIMEOUT = $2001;
var
  ForegroundThreadID: DWORD;
  ThisThreadID: DWORD;
  timeout: DWORD;
begin
  if IsIconic(hwnd) then
    ShowWindow(hwnd, SW_RESTORE);
  if GetForegroundWindow = hwnd then
    Result := true
  else
  begin
    {Windows 98/2000 doesn't want to foreground a window when some
    other window has keyboard focus}
    if ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion > 4))
      or ((Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and ((Win32MajorVersion > 4)
      or ((Win32MajorVersion = 4) and (Win32MinorVersion > 0)))) then
    begin
      {Code from Karl E. Peterson, www.mvps.org/vb/sample.htm
      Converted to Delphi by Ray Lischner
      Published in The Delphi Magazine 55, page 16}
      Result := false;
      ForegroundThreadID := GetWindowThreadProcessID(GetForegroundWindow, nil);
      ThisThreadID := GetWindowThreadProcessId(hwnd, nil);
      if AttachThreadInput(ThisThreadID, ForegroundThreadID, true) then
      begin
        BringWindowToTop(hwnd); {IE 5.5 related hack}
        SetForegroundWindow(hwnd);
        AttachThreadInput(ThisThreadID, ForegroundThreadID, false);
        Result := (GetForegroundWindow = hwnd);
      end;
      if not Result then
      begin
        {Code by Daniel P. Stasinski}
        SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @timeout, 0);
        SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(0),
          SPIF_SENDCHANGE);
        BringWindowToTop(hwnd); {IE 5.5 related hack}
        SetForegroundWindow(hWnd);
        SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(timeout),
          SPIF_SENDCHANGE);
      end;
    end
    else
    begin
      BringWindowToTop(hwnd); {IE 5.5 related hack}
      SetForegroundWindow(hwnd);
    end;
    Result := (GetForegroundWindow = hwnd);
  end;
end;

Exporting an TImage contents to WMF format

Problem/Question/Abstract:

How can I export the content of a TImage for an image in the format of Clip Galleyr of Microsoft Office?

Answer:

I used this function once and she worked.

procedure ExportBMPtoWMF(Imagem: TImage; Dest: Pchar);
//
// Export an TImage contents to WMF format (Microsoft Clippart format file)
//
var
  Metafile: TMetafile;
  MetafileCanvas: TMetafileCanvas;
  DC: HDC;
  ScreenLogPixels: Integer;
begin
  Metafile := TMetafile.Create;
  try
    DC := GetDC(0);
    ScreenLogPixels := GetDeviceCaps(DC, LOGPIXELSY);
    Metafile.Inch := ScreenLogPixels;
    Metafile.Width := Imagem.Picture.Bitmap.Width;
    Metafile.Height := Imagem.Picture.Bitmap.Height;
    MetafileCanvas := TMetafileCanvas.Create(Metafile, DC);
    ReleaseDC(0, DC);
    try
      MetafileCanvas.Draw(0, 0, Imagem.Picture.Bitmap);
    finally
      MetafileCanvas.Free;
    end;
    Metafile.Enhanced := FALSE;
    Metafile.SaveToFile(Dest);
  finally
    Metafile.Destroy;
  end;
end;

Create a locked file

Problem/Question/Abstract:

I was using temporary files on the root of the disk, but the user could try to modify it when my application was open and I didn't want that. Here's how to prevent it.

Answer:

Solve 1:

There are two ways of doing that, but one, with the use of Windows' APIs (LockFileEx and UnlockFileEx) using the parameter LOCKFILE_EXCLUSIVE_LOCK was not good for my case, so I found that:

Create the file with the OpenFile function and handle it:

hMyLockedFile := OpenFile('c:\variables.dat', ofStruct, OF_CREATE or OF_READWRITE or
  OF_SHARE_EXCLUSIVE);

Now, you can work with your file, but users cannot change it!

A last comment:
I found that in Win32 SDK Reference, so if you need to know more (and there's more to know: believe me!) you should use it!


Solve 2:

var
  SA: TSecurityAttributes;
  MyText: array[0..500] of char;
  BWritten: DWord;
  OK: Boolean;
begin
  MyText := 'Mark Halter' + chr(13) + Chr(10) + 'S�dstr. 6';

  with SA do
  begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;

  Hndl := CreateFile('d:\temp\testfile.txt', // filename
    GENERIC_READ or GENERIC_WRITE, // read/write access
    0, // do not share file
    @SA, // Security Attributes
    CREATE_ALWAYS, // create file everytime
    FILE_ATTRIBUTE_NORMAL, // set normal attributs
    0);

  OK := WriteFile(Hndl,
    MyText,
    StrLen(MyText),
    BWritten,
    nil);

  CloseHandle(Hndl);
end;

Limit the form position to the screen's work area

Problem/Question/Abstract:

What's the best windows message to check if the Form's position is beyond the desktop area, when the user is moving it? How can I prevent the form/ mouse from moving when that happens?

Answer:

Solve 1:

You need a message that is send to the form before it moves and allows you to modfify the position it is about to move to before it actually does move. WM_MOVING or WM_WINDOWPOSCHANGING fit that bill. I would use the second, WM_MOVING will not be send if the user has switched off the "drag full window" option.

Limit a form to the screens workarea:

{ Private declarations }

procedure WMWINDOWPOSCHANGING(var msg: TWMWINDOWPOSCHANGING);
  message WM_WINDOWPOSCHANGING;

procedure TForm1.WMWINDOWPOSCHANGING(var msg: TWMWINDOWPOSCHANGING);
var
  r: TRect;
begin
  if ((SWP_NOMOVE or SWP_NOSIZE) and msg.WindowPos^.flags) < > (SWP_NOMOVE
    or SWP_NOSIZE) then
  begin
    {Window is moved or sized, get usable screen area}
    SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0);
    {Check if operation would move part of the window out of this area.
                If so correct position and, if required, size, to keep window fully inside
                the workarea. Note that simply adding the SWM_NOMOVE and SWP_NOSIZE flags
                to the flags field does not work as intended if full dragging of windows is
                disabled. In this case the window would snap back to the start position instead
                of stopping at the edge of the workarea, and you could still move the
    drag rectangle outside that area. }
    with msg.WindowPos^ do
    begin
      if x < r.left then
        x := r.left;
      if y < r.top then
        y := r.top;
      if (x + cx) > r.right then
      begin
        x := r.right - cx;
        if x < r.left then
        begin
          cx := cx - (r.left - x);
          x := r.Left;
        end;
      end;
      if (y + cy) > r.bottom then
      begin
        y := r.bottom - cy;
        if y < r.top then
        begin
          cy := cy - (r.top - y);
          y := r.top;
        end;
      end;
    end;
  end;
  inherited;
end;

Delphi 4.03 does not recognize TWMMOVING, because there is no message record type declared for it for some reason. That is easily fixed, however:

type
  TWmMoving = record
    Msg: Cardinal;
    fwSide: Cardinal;
    lpRect: PRect;
    Result: Integer;
  end;


Solve 2:

You can get this behaviour by handing the WM_MOVING message in the form. The message is send to the form before it actually moves, so you can modify the rectangle with the new form position before you pass the message on to the inherited handler.

For some reason messages.pas declares no message record for this message.

type
  TWmMoving = record
    Msg: Cardinal;
    fwSide: Cardinal;
    lpRect: PRect;
    Result: Integer;
  end;

Add a handler to your forms private section:

procedure WMMoving(var msg: TWMMoving); message WM_MOVING;

Implement it as:

procedure TFormX.WMMoving(var msg: TWMMoving);
var
  r: TRect;
begin
  r := Screen.WorkareaRect;
  {Compare the new form bounds in msg.lpRect^ with r and modify it if necessary}
  if msg.lprect^.left < r.left then
    OffsetRect(msg.lprect^, r.left - msg.lprect^.left, 0);
  if msg.lprect^.top < r.top then
    OffsetRect(msg.lprect^, 0, r.top - msg.lprect^.top);
  if msg.lprect^.right > r.right then
    OffsetRect(msg.lprect^, r.right - msg.lprect^.right, 0);
  if msg.lprect^.bottom > r.bottom then
    OffsetRect(msg.lprect^, 0, r.bottom - msg.lprect^.bottom);
  inherited;
end;

Is font "X" installed?

Problem/Question/Abstract:

How to determine if a font is installed

Answer:

You can just use this function, or put the code directly wherever you need it

function FontInstalled(const FontName: string): Boolean;
begin
  Result := Screen.Fonts.IndexOf(FontName) > 0
end;

then just call it

if not (FontInstalled('Pilobolus')) then
begin
  ShowMessage('Pilobolus font is not installed!')
    //you can do stuff here to install it, or whatever you need...
end;

TStringGrid functions (Delete, Insert, Sort)

Problem/Question/Abstract:

How to insert, delete or sort columns in StringGrids

Answer:

Solve 1:

procedure GridRemoveColumn(StrGrid: TStringGrid; DelColumn: Integer);
var
  Column: Integer;
begin
  if DelColumn <= StrGrid.ColCount then
  begin
    for Column := DelColumn to StrGrid.ColCount - 1 do
      StrGrid.Cols[Column - 1].Assign(StrGrid.Cols[Column]);
    StrGrid.ColCount := StrGrid.ColCount - 1;
  end;
end;

procedure GridAddColumn(StrGrid: TStringGrid; NewColumn: Integer);
var
  Column: Integer;
begin
  StrGrid.ColCount := StrGrid.ColCount + 1;
  for Column := StrGrid.ColCount - 1 downto NewColumn do
    StrGrid.Cols[Column].Assign(StrGrid.Cols[Column - 1]);
  StrGrid.Cols[NewColumn - 1].Text := '';
end;

procedure GridSort(StrGrid: TStringGrid; NoColumn: Integer);
var
  Line, PosActual: Integer;
  Row: TStrings;
begin
  Renglon := TStringList.Create;
  for Line := 1 to StrGrid.RowCount - 1 do
  begin
    PosActual := Line;
    Row.Assign(TStringlist(StrGrid.Rows[PosActual]));
    while True do
    begin
      if (PosActual = 0) or (StrToInt(Row.Strings[NoColumn - 1]) >=
        StrToInt(StrGrid.Cells[NoColumn - 1, PosActual - 1])) then
        Break;
      StrGrid.Rows[PosActual] := StrGrid.Rows[PosActual - 1];
      Dec(PosActual);
    end;
    if StrToInt(Row.Strings[NoColumn - 1]) < StrToInt(StrGrid.Cells[NoColumn - 1,
      PosActual]) then
      StrGrid.Rows[PosActual] := Row;
  end;
  Renglon.Free;
end;


Solve 2:

Had a few problems with range errors with the algorythms. On Delete or Add columns it is desirable to keep the widths of the columns as they are moved. Add column could also take the width of the new column (or default to DefaultColWidth if zero). I also had range errors in the Grid sort. On a large grid a Quicksort routine would be more desirable.

The Quicksort routine could take various sort modes as a parameter eg. Alpha,Double,Integer etc. (have supported only these 3 in demo, but it's easy to see how to incorporate more). The quick sort should also take "from row - to row" as parameters as we normally would not want to sort the header, or just a sub range may be required to be
sorted.

All in all though, some nice ideas for an extended stringgrid class, couple with DeleteRow, AddRow, LoadFromQuery etc.

procedure RemoveColumn(SG: TStringGrid; ColNumber: integer);
var
  Column: integer;
begin
  ColNumber := abs(ColNumber);

  if ColNumber <= SG.ColCount then
  begin
    for Column := ColNumber to SG.ColCount - 2 do
    begin
      SG.Cols[Column].Assign(SG.Cols[Column + 1]);
      SG.Colwidths[Column] := SG.Colwidths[Column + 1];
    end;
    SG.ColCount := SG.ColCount - 1;
  end;
end;

procedure AddColumn(SG: TStringGrid; AtColNumber: integer;
  ColWidth: integer = 0);
var
  Column: integer;
  Wdth: integer;
begin
  AtColNumber := abs(AtColNumber);
  SG.ColCount := SG.ColCount + 1;
  if abs(ColWidth) = 0 then
    Wdth := SG.DefaultColWidth
  else
    Wdth := ColWidth;

  if AtColNumber <= SG.ColCount then
  begin
    for Column := SG.ColCount - 1 downto AtColNumber + 1 do
    begin
      SG.Cols[Column].Assign(SG.Cols[Column - 1]);
      SG.Colwidths[Column] := SG.Colwidths[Column - 1];
    end;

    SG.Cols[AtColNumber].Text := '';
    SG.Colwidths[AtColNumber] := Wdth;
  end;
end;


Solve 3:

type
  TStringGridExSortType = (srtAlpha, srtInteger, srtDouble);

procedure GridSort(SG: TStringGrid; ByColNumber, FromRow, ToRow: integer;
  SortType: TStringGridExSortType = srtAlpha);
var
  Temp: TStringList;

  function SortStr(Line: string): string;
  var
    RetVar: string;
  begin
    case SortType of
      srtAlpha: Retvar := Line;
      srtInteger: Retvar := FormatFloat('000000000', StrToIntDef(trim(Line), 0));
      srtDouble:
        try
          Retvar := FormatFloat('000000000.000000', StrToFloat(trim(Line)));
        except
          RetVar := '0.00';
        end;
    end;

    Result := RetVar;
  end;

  // Recursive QuickSort
  procedure QuickSort(Lo, Hi: integer; CC: TStrings);

    procedure Sort(l, r: integer);
    var
      i, j: integer;
      x: string;
    begin
      i := l;
      j := r;
      x := SortStr(CC[(l + r) div 2]);
      repeat
        while SortStr(CC[i]) < x do
          inc(i);
        while x < SortStr(CC[j]) do
          dec(j);
        if i <= j then
        begin
          Temp.Assign(SG.Rows[j]); // Swap the 2 rows
          SG.Rows[j].Assign(SG.Rows[i]);
          SG.Rows[i].Assign(Temp);
          inc(i);
          dec(j);
        end;
      until i > j;
      if l < j then
        sort(l, j);
      if i < r then
        sort(i, r);
    end;

  begin {quicksort}
    Sort(Lo, Hi);
  end;

begin
  Temp := TStringList.Create;
  QuickSort(FromRow, ToRow, SG.Cols[ByColNumber]);
  Temp.Free;
end;

Speech Part 1 - How to Add "Text to Speech" (Speech Synthesis) to your Delphi Apps

Problem/Question/Abstract:

How can I get my application to read text?

Answer:

On Aug 11, 2001 Microsoft released the SAPI 5.1 SDK. This is significant because SAPI 5.1  is fully automated. That is you can use it from any language that supports OLE automation. These are not Active X controls and can be either early or late bound.

In this article I&#8217;m going to show you how to get and install the SAPI 5.1 SDK. Then I&#8217;m going to show how to use the SDK convert text to synthesized speech in a Delphi application. The synthesized speech is played over you computers speakers. I test this in Delphi 5 and 6.

To get SAPI 5.1 you need to go to Microsoft&#8217;s Speech.net Technologies web site at

http://www.microsoft.com/speech

and follow the link to the download. Right next to the download link is the release notes link. READ THE RELEASE NOTE! Especially if your development machine is using a default language other than US English.

If you are running a beta version of the XP operating system you might have some problems. This is because SAPI 5.1 is built into XP and the most recent public beta of XP as of this writing (RC 2) includes an earlier version of SAPI 5.1. Don&#8217;t try to install the release version of SAPI 5.1 into XP, it will not work.

Once you read the release notes follow the link to the Speech SDK 5.1 Download page. In most cases all you need to download is the link labeled &#8220;Speech SDK 5.1 (68 MB). This contains the SDK, the documentation and the free Microsoft English text to speech and speech recognition engines. The download is very large, 68 MB, so unless you have a high speed connection to the internet you might want to order the SDK CD from Microsoft.

&#8230;. Time passes while you download or wait for the postman &#8230;.

Ok, now you have the SAPI 5.1 SDK. Run the speechsdk51.exe to install it on your development system.

DELPHI 6 Users IMPORTANT
There is a bug in the type library import in Delphi 6 see article "Delphi 6 - Imported Automation Events Bug". This sample will still work with the unit created by the type libary import in Delphi 6 but only because none of the events for the component are used. If you want to use any of the SPVoice events you will need to read article "Delphi 6 - Imported Automation Events Bug".

What you need to do now is make Delphi aware of the new SAPI automation objects. To do this, start up Delphi 5 or 6 (I didn&#8217;t try earlier versions) and go to Project | Import Type Library. In the Import Type Library dialog highlight &#8220;Microsoft Speech Object Library (Version 5.1)&#8221;. If you don&#8217;t find this in the list then something&#8217;s wrong with the installation of SAPI 5.1.

Delphi is going to want to put the SAPI components on your ActiveX palette page. I recommend you put these on a new palette page called &#8220;SAPI 5&#8221; since the number of components installed is large (19). You may also want to choose a &#8220;Unit dir name&#8221; of something other than the default. Make sure the &#8220;Generate Component Wrapper&#8221; check box is checked and press the >Install< button.

In the Install dialog choose the &#8220;Into new package&#8221; tab and in the &#8220;File name:&#8221; field give a package name like &#8220;SAPI5.dpk&#8221; press the browse button and make sure the dpk is created in the same directory where you created the components. Actually this isn&#8217;t completely necessary it just helps keep things together. In the Install dialog&#8217;s Description field give some meaningful description like &#8220;SAPI 5 automation components&#8221;. Press OK

Press yes in the confirm dialog and the new components will be created and installed.

If you now look in the directory you specified for the components you should find SpeechLib_TLB.pas (and dcr) which contains all the component code as well as interface, const, type and other useful information. This is your most valuable piece of documentation on the SDK. I&#8217;ve found it even better than the Microsoft SAPI 5.1 documentation which is pretty good. This directory should also contain (if you followed the above instructions) the SAPI5.dpk which is your package source.

If you go to the far eastern end of your component palette you should find the new SAPI5 palette page with its 19 speech components.

Now for the fun part.

Let&#8217;s make an application that can synthesize speech. In Delphi start a new application and drop a button on the form. On the SAPI5 palette page find the SpVoice component and drop it on the form. On my machine this component is the 5th one reading from left to right.

Now create an onClick event for you button that looks something like this;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SpVoice1.Speak('Hello world!', SVSFDefault);
end;

Run the program and press the button. Cool hu?

At this level it&#8217;s amazingly simple. The SPVoice objects Speak method is very powerful. This power comes from the second parameter. For the above example I choose to use the default mode which causes the speak method to return only when the synthesis is complete, not to purge pending speech requests, to respond to special XML control tags embedded in the text.

The SDKs documentation is contained in sapi.chm which you will find in the  \Program Files\Microsoft Speech SDK 5.1\Docs\Help directory.

Sapi.chm contains a lot of information. To go directly to the meat of the subject go to the last folder on the outlines 1st level titled Automation and go down to SPVoice and then to the Speak method read what&#8217;s there and also be sure to follow the link to the SpeechVoiceSpeakFlags info. You will find that in addition to just speaking passed in text that can also do much more some of the more interesting flags are;

Pass in a file name and speak the text in the file. (SVSFIsFilename)
Make the function either return immediately (asynchronously) or only after the synthesis is complete(synchronously). If you speak asynchronously there are events available to fire when the speech is done. (SVSFlagsAsync)
Embed flags in the text that can control various aspects of the synthesis like pitch, rate, emphasis, and much more (see the included White Paper titled &#8220;XML TTS Tutorial&#8221;). I found this feature a bit addicting as I attempted to make the synthesized voice sing.( SVSFIsXML)

One interesting thing I found (but not documented) was that you can speak a web sites title by setting the flag to SVSFIsFilenam and passing a URL. If you are connected to the internet, try replacing the speak line in the sample line with

SpVoice1.Speak('http://www.o2a.com', SVSFIsFilename);

And run it.

Even more bizarre is you can use the speak method to play wav files. Try

SpVoice1.Speak('C:\WINNT\MEDIA\Windows Logon Sound.wav', SVSFIsFilename);

There&#8217;s a lot more to SAPI then text to speech and there&#8217;s more to text to speech then what I&#8217;ve covered here. Hopefully this will be the first of a number of articles on SAPI but I&#8217;ll only do them if you&#8217;re interested so please be sure to comment. Also I&#8217;m completely open to suggestions on what you&#8217;d like to see next (if anything at all).

If you want to talk privately I&#8217;m at alecb@o2a.com.

Debug Delphi 3 experts with Delphi 3

Problem/Question/Abstract:

Debug Delphi 3 experts with Delphi 3

Answer:

Delphi 3 has a new feature "debug DLLs". It can be used to debug experts with the internal debugger. Just follow these simple steps, and debugging an expert can be fun:

Make sure that the expert is not installed. If there is this entry  \CURRENT_USER\software\Delphi\3.0\experts, myexpert=\projects\myexpert\expert.dll rename this entry to "expert.xxx". (don't delete it, you'll need it later). Otherwise, you cannot compile a new version.

Run Delphi, open your expert's project as used, compile it and set the break points you think you need.

Go to the menu item run | parameters. This is the new Delphi 3 feature mentioned above.

Surprise: the host application is Delphi itself! So, next to the field "host app", enter something like e:\Programs\delphi3\bin\delphi32.exe (with path)

Second trick: now we install the expert... If you have "expert.xxx" installed, rename that to "expert.dll". This will be used by any Delphi instance started from now on.

Run "your application" (= Delphi 3) using menu item run | run. If you have enough RAM, Delphi is loaded and this instance will have your expert installed. Activate the expert, you'll have the possibility to use the comfort of the first instance's internal debugger.

Close the right instance of Delphi - and you can modify/ recompile etc. your expert.

Getting a page from a webserver and put it in a string variable

Problem/Question/Abstract:

How do I get a page from a webserver only using TClientSocket?

Answer:

Attach the following event-handlers to your TClientSocket. It gets the file from the server and puts it in the FText string variable. Btw, it doesn't remove the header that is also send by the webserver.
Don't forget to setup your Socket object with a correct server adress. Set port to 80. And open it with "Socket.Open;".
I wrote this as part of an AutoUpdate feature in one of my applications.

const
  WebPage = '/index.html';
var
  FText: string;

procedure TForm1.SocketWrite(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Socket.SendText('GET ' + Webpage + ' HTTP/1.0'#10#10);
end;

procedure TForm1.SocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  FText := FText + Socket.ReceiveText
end;

procedure TForm1.SocketConnecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  FText := '';
end;

procedure TForm1.SocketDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  { --- }
  { HERE YOU CAN PROCESS YOUR FText !!! }
  { --- }
end;

procedure TForm1.SocketError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  ErrorCode := 0; { Just ignore errors }
end;