Using MS Word as a Spelling and Grammar Checker for Delphi

The COM interface exposed by MS Word gives a number of mechanisms for the use of the spelling engine.

• The Word.Application object can call the engine for a single word or string. The return value is a Boolean indicating True (no errors) or False (errors). Further work must be done to provide spelling suggestions / correction.
• The Document object contained by the Word.Application object exposes all the functionality of MS Word, in particular, the MS Word dialog boxes for spelling and grammar checking can be used.

The technique used in this component is the second method. Text is copied to the (hidden) word document, then the appropriate function (spelling or grammar) is called. To discover if the user made any changes to the text, MS Word's ability to track changes is utilised.

RTF text can be checked easily by using the CheckClipBoardSpell / Grammar functions.

Custom Dictionaries: Using custom dictionaries is a powerful feature of Word's spelling checker but there appears to be an error in the documentation (at least I can't get it to work as written in Delphi or VBA within Word itself!). Custom dictionaries are text files (usually with a '.dic' extension) with a sorted list of words - one word on each line. Included the ability to "install" a custom dictionary(s) which will be used in all spell checks. The down side is that the dictionary will now be seen by Word all the time, so it's probably a good idea to remove any such dictionary before exiting your program.

Checking if the user wants to cancel spell/grammar checking: In your own program you could check for the press of a "cancel" button or key. This isn't available when using Word's built in dialogs, so I tend to use the SpellingChecked and GrammarChecked properties to check if there are still errors in the text after a spell check has been completed. If the user has decided to quit, these properties should be False. I have mapped them into the UserCancel property for ease of programming.

Installation is very simple, just copy the code and save it as uSpellCheck.pas and include any of your existing/new dpk file.

How to use:
i) Drop the TActionList component onto a form.
ii) Select StandardAction from TActionList
iii)You will see new TSpellCheck action item under Edit category. select it ;-)
By default this action item is associated with F7 shortcut.
iv) Drop few Editable controls like TEdit, TMemo, TRichEdit etc and run the application and press F7 to trigger Spell Check.

That's it really!

{
Unit Name   : uSpellCheck.pas
Description : TSpellCheck is derived from TEditAction, which is available on
              TActionList. This newly created action acts as a standard EditAction
              for example: It gets enabled when the control is in Editable mode.
Enhancements: Couldn't think of any more as of now...
Create Date : 1st December 2010
Author      : Kiran Kumar Kurapaty
Code enhanced from original author: Andrew Baylis (ajbaylis@melbpc.org.au), Thanks Andrew.
}

unit uSpellCheck;

interface

uses Windows, SysUtils, Classes, ActnList, Forms, StdCtrls, Dialogs, StdActns, ActnRes, Messages, ComObj,
     ActiveX, Variants;

type
  TWordTimer = class(TThread)
  private
    FCaption: string;
    FDelay: Integer;
    FDialogWndClass: string;
    FPopUpExists: Boolean;
    procedure SetDelay(Value: Integer);
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean);
    procedure Resume;
    property Caption: string read FCaption write FCaption;
    property Delay: Integer read FDelay write SetDelay;
    property DialogWndClass: string read FDialogWndClass write FDialogWndClass;
  end;

  TSpellLanguage = Integer;

  TSpellCheck = class(TEditAction)
  private
    FCancel: Boolean;
    FChangedText: string;
    FConnected: Boolean;
    FHandle: HWND;
    FNumChanges: Integer;
    FOleOn: Boolean;
    FSpellCaption: string;
    FTimer: TWordTimer;
    FUseSpellCaption: Boolean;
    FWordApp, FRange, FWordDoc, FCustDics: OLEVariant;
    FWordDialogClass: string;
    FWordVersion: string;
    FLanguage: TSpellLanguage;
    function GetCheckGWS: Boolean;
    function GetGrammarErrors: Integer;
    function GetSpellChecked: Boolean;
    function GetSpellErrors: Integer;
    function GetUserCancel: Boolean;
    function GetVersion: string;
    function GetWordVersion: string;
    procedure SetCheckGWS(const Value: Boolean);
    procedure SetLanguage(Value: TSpellLanguage);
  protected
    function Internal_checkGrammar: Boolean;
    function Internal_checkSpelling: Boolean;
    procedure StartTimer;
    procedure StopTimer;
  public
    procedure ExecuteTarget(Target: TObject); override;
    procedure UpdateTarget(Target: TObject); override;

    function AddCustomDic(const FileName: string): Integer;
    function CheckClipboardGrammar: Boolean;
    function CheckClipboardSpell: Boolean;
    function CheckGrammar(const Text: string): Boolean;
    function CheckSpelling(const Text: string): Boolean;
    procedure ClearText;
    procedure Connect;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Disconnect;
    procedure RemoveCustomDic(const Name: string); overload;
    procedure RemoveCustomDic(const Index: Integer); overload;
    procedure ResetIgnoreAll;
    procedure SpellingOptions;

    property ChangedText: string read FChangedText;
    property CheckGrammarWithSpelling: Boolean read GetCheckGWS write SetCheckGWS;
    property Connected: Boolean read FConnected;
    property GrammarErrorCount: Integer read GetGrammarErrors;
    property NumChanges: Integer read FNumChanges;
    property SpellChecked: Boolean read GetSpellChecked;
    property SpellErrorCount: Integer read GetSpellErrors;
    property UserCancelled: Boolean read GetUserCancel write FCancel;
    property WordVersion: string read GetWordVersion;
  published
    property SpellCaption: string read FSpellCaption write FSpellCaption;
    property UseSpellCaption: Boolean read FUseSpellCaption write FUseSpellCaption;
    property Version: string read GetVersion;
    property Language: TSpellLanguage read FLanguage write SetLanguage;
  end;

  LangRecord = record
    LocalName: string;
    ID: Integer;
  end;

const // Spelling Language
   SpellLanguage: array[0..63] of LangRecord =
      ((LocalName: 'LanguageNone'; ID: $00000000),
      (LocalName: 'NoProofing '; ID: $00000400),
      (LocalName: 'Danish '; ID: $00000406),
      (LocalName: 'German '; ID: $00000407),
      (LocalName: 'SwissGerman '; ID: $00000807),
      (LocalName: 'EnglishAUS '; ID: $00000C09),
      (LocalName: 'EnglishUK '; ID: $00000809),
      (LocalName: 'EnglishUS '; ID: $00000409),
      (LocalName: 'EnglishCanadian '; ID: $00001009),
      (LocalName: 'EnglishNewZealand '; ID: $00001409),
      (LocalName: 'EnglishSouthAfrica '; ID: $00001C09),
      (LocalName: 'Spanish '; ID: $0000040A),
      (LocalName: 'French '; ID: $0000040C),
      (LocalName: 'FrenchCanadian '; ID: $00000C0C),
      (LocalName: 'Italian '; ID: $00000410),
      (LocalName: 'Dutch '; ID: $00000413),
      (LocalName: 'NorwegianBokmol '; ID: $00000414),
      (LocalName: 'NorwegianNynorsk '; ID: $00000814),
      (LocalName: 'BrazilianPortuguese '; ID: $00000416),
      (LocalName: 'Portuguese '; ID: $00000816),
      (LocalName: 'Finnish '; ID: $0000040B),
      (LocalName: 'Swedish '; ID: $0000041D),
      (LocalName: 'Catalan '; ID: $00000403),
      (LocalName: 'Greek '; ID: $00000408),
      (LocalName: 'Turkish '; ID: $0000041F),
      (LocalName: 'Russian '; ID: $00000419),
      (LocalName: 'Czech '; ID: $00000405),
      (LocalName: 'Hungarian '; ID: $0000040E),
      (LocalName: 'Polish '; ID: $00000415),
      (LocalName: 'Slovenian '; ID: $00000424),
      (LocalName: 'Basque '; ID: $0000042D),
      (LocalName: 'Malaysian '; ID: $0000043E),
      (LocalName: 'Japanese '; ID: $00000411),
      (LocalName: 'Korean '; ID: $00000412),
      (LocalName: 'SimplifiedChinese '; ID: $00000804),
      (LocalName: 'TraditionalChinese '; ID: $00000404),
      (LocalName: 'SwissFrench '; ID: $0000100C),
      (LocalName: 'Sesotho '; ID: $00000430),
      (LocalName: 'Tsonga '; ID: $00000431),
      (LocalName: 'Tswana '; ID: $00000432),
      (LocalName: 'Venda '; ID: $00000433),
      (LocalName: 'Xhosa '; ID: $00000434),
      (LocalName: 'Zulu '; ID: $00000435),
      (LocalName: 'Afrikaans '; ID: $00000436),
      (LocalName: 'Arabic '; ID: $00000401),
      (LocalName: 'Hebrew '; ID: $0000040D),
      (LocalName: 'Slovak '; ID: $0000041B),
      (LocalName: 'Farsi '; ID: $00000429),
      (LocalName: 'Romanian '; ID: $00000418),
      (LocalName: 'Croatian '; ID: $0000041A),
      (LocalName: 'Ukrainian '; ID: $00000422),
      (LocalName: 'Byelorussian '; ID: $00000423),
      (LocalName: 'Estonian '; ID: $00000425),
      (LocalName: 'Latvian '; ID: $00000426),
      (LocalName: 'Macedonian '; ID: $0000042F),
      (LocalName: 'SerbianLatin '; ID: $0000081A),
      (LocalName: 'SerbianCyrillic '; ID: $00000C1A),
      (LocalName: 'Icelandic '; ID: $0000040F),
      (LocalName: 'BelgianFrench '; ID: $0000080C),
      (LocalName: 'BelgianDutch '; ID: $00000813),
      (LocalName: 'Bulgarian '; ID: $00000402),
      (LocalName: 'MexicanSpanish '; ID: $0000080A),
      (LocalName: 'SpanishModernSort '; ID: $00000C0A),
      (LocalName: 'SwissItalian '; ID: $00000810));


  procedure Register;

implementation

uses Registry;

{ TSpellCheck }
procedure TSpellCheck.ExecuteTarget(Target: TObject);
begin
  if Assigned(GetControl(Target)) then
  begin
    try
      if CheckSpelling(GetControl(Target).Text) then
        GetControl(Target).Text := ChangedText;
    except
      on E:Exception do
        MessageDlg(Format('There was an error calling the Spell Checker (%s) - '+
                          'you may need to close some Windows Applications and try again',
                          [E.message]), mtError, [mbOk], 0);
    end;
  end;
end;

procedure TSpellCheck.UpdateTarget(Target: TObject);
begin
  inherited;
  Enabled := Length(GetControl(Target).Text) > 0;
end;



type
  TSpellCheckActionClass = class of TSpellCheck;
  TEditActionClass = class of TEditAction;

  TEditActionWrapper = class(StdActns.TEditAction);

  TSpellCheckEditActionInfo = record
    SpellCheckActionClass: TSpellCheckActionClass;
    EditActionClass: TEditActionClass;
    DefaultCaption: string;
    DefaultHint: string;
    DefaultImageIndex: Integer;
    DefaultShortCut: TShortCut;
  end;

  TStandardActionsEx = class(TStandardActions)
  protected
    procedure CreateByInfo(AEditActionsInfo: TSpellCheckEditActionInfo);
    function FindEditActionByClassType(AEditActionClass: TEditActionClass): TEditAction;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{purpose: Add default properties of future actions here...}
const
  CH4EditActionsCount = 1;
  CH4EditActionsInfo: array [0..CH4EditActionsCount-1] of TSpellCheckEditActionInfo =
  (
    ( SpellCheckActionClass: TSpellCheck;
      EditActionClass: TEditAction;
      DefaultCaption: '&Spell Check';
      DefaultHint: 'Spell Check|Check for Spellings and Grammer.';
      DefaultImageIndex: -1;
      DefaultShortCut: VK_F7)
  );

constructor TStandardActionsEx.Create(AOwner: TComponent);
var
  I: Integer;
begin
  inherited;
  for I := Low(CH4EditActionsInfo) to High(Ch4EditActionsInfo) do
    CreateByInfo(CH4EditActionsInfo[I]);
end;

procedure TStandardActionsEx.CreateByInfo(AEditActionsInfo: TSpellCheckEditActionInfo);
var
  AEditAction: TEditAction;
  ASpellCheckEditAction: TEditAction;
begin
  AEditAction := FindEditActionByClassType(AEditActionsInfo.EditActionClass);
  ASpellCheckEditAction := AEditActionsInfo.SpellCheckActionClass.Create(Self);
  with ASpellCheckEditAction do
  begin
    if AEditAction <> nil then
    begin
      Caption := TEditActionWrapper(AEditAction).Caption;
      Hint := TEditActionWrapper(AEditAction).Hint;
      ImageIndex := TEditActionWrapper(AEditAction).ImageIndex;
      ShortCut := TEditActionWrapper(AEditAction).ShortCut;
    end
    else
    begin
      Caption := AEditActionsInfo.DefaultCaption;
      Hint := AEditActionsInfo.DefaultHint;
      ImageIndex := AEditActionsInfo.DefaultImageIndex;
      ShortCut := AEditActionsInfo.DefaultShortCut;
    end;
  end;
end;

function TStandardActionsEx.FindEditActionByClassType(AEditActionClass: TEditActionClass): TEditAction;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to ComponentCount - 1 do
    if (Components[I].ClassType = AEditActionClass) and (Components[I] is TEditAction) then
    begin
      Result := Components[I] as TEditAction;
      Break;
    end;
end;

procedure Register;
begin
  RegisterActions('Edit', [TSpellCheck], TStandardActionsEx);
end;

// these constants used to identify the window class of Word's dialog box
const
  //Constants for MS Word
   MSDialogWndClass2000 = 'bosa_sdm_Microsoft Word 9.0';
   MSDialogWndClass97 = 'bosa_sdm_Microsoft Word 8.0';
   MSWordWndClass = 'OpusApp';
   CSpellerVersion = '1.0';

function IsWordPresent: Boolean;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CLASSES_ROOT;
    Result := Reg.KeyExists('Word.Application');
  finally
    Reg.Free;
  end;
end;

{ TSpellCheck }
function TSpellCheck.GetCheckGWS: Boolean;
begin
  Result := False;
  if FConnected then Result := FWordApp.Options.CheckGrammarWithSpelling;
end;

function TSpellCheck.GetGrammarErrors: Integer;
begin
  if FConnected then
    Result := FRange.GrammaticalErrors.Count
  else
    Result := 0;
end;

function TSpellCheck.GetSpellChecked: Boolean;
// returns false if spelling has yet to be checked
begin
  Result := True;
  if FConnected then Result := not FRange.SpellingChecked;
end;

function TSpellCheck.GetSpellErrors: Integer;
begin
  if FConnected then
    Result := FRange.SpellingErrors.Count
  else
    Result := 0;
end;

function TSpellCheck.GetUserCancel: Boolean;
begin
  Result := FCancel;
end;

function TSpellCheck.GetVersion: string;
begin
  Result := CSpellerVersion;
end;

function TSpellCheck.GetWordVersion: string;
begin
  Result := FWordVersion;
end;

procedure TSpellCheck.SetCheckGWS(const Value: Boolean);
begin
  if FConnected then FWordApp.Options.CheckGrammarWithSpelling := Value;
end;

function TSpellCheck.Internal_checkGrammar: Boolean;
begin
  SetWindowPos(FHandle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE + SWP_HIDEWINDOW); // ensures dialogs appear in front
  FWordDoc.TrackRevisions := True; // note if changes are made
  FNumChanges := 0;

  FRange.GrammarChecked := False;
  if (FLanguage > 0) then // 0 means use the default setting
    FRange.LanguageID := SpellLanguage[FLanguage].ID;

  StartTimer;
  OleCheck(FRange.CheckGrammar);
  StopTimer;

  FCancel := not FRange.GrammarChecked;
  FWordApp.Visible := False; // need to stop ActiveDocument appearing

  FNumChanges := FRange.Revisions.Count; // seems revisions counts the old word and the new one separately
  Result := (FRange.Revisions.Count > 0);
  if Result then FRange.Revisions.AcceptAll; // accept all changes

  FWordDoc.TrackRevisions := False; // don't track future changes
end;

function TSpellCheck.Internal_checkSpelling: Boolean;
begin
  SetWindowPos(FHandle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE + SWP_HIDEWINDOW); // ensures dialogs appear in front
  FWordDoc.TrackRevisions := True; // note if changes are made
  FNumChanges := 0;

  if (FLanguage > 0) then // 0 means use the default setting
     FRange.LanguageID := SpellLanguage[FLanguage].ID;

  StartTimer;
  OleCheck(FWordDoc.CheckSpelling);
  StopTimer;

  FCancel := not FWordDoc.SpellingChecked;
  FWordApp.Visible := False; // need to stop ActiveDocument appearing

  FNumChanges := FRange.Revisions.Count; // seems revisions counts the old word and the new one separately
  Result := (FRange.Revisions.Count > 0);
  if Result then FRange.Revisions.AcceptAll; // accept all changes

  FWordDoc.TrackRevisions := False; // don't track future changes
end;

procedure TSpellCheck.StartTimer;
begin
  if FUseSpellCaption then
  begin
    FTimer.Caption := FSpellCaption;
    FTimer.Resume;
  end;
end;

procedure TSpellCheck.StopTimer;
begin
  FTimer.Suspend;
end;

function TSpellCheck.AddCustomDic(const FileName: string): Integer;
begin
  FCustDics.Add(FileName);
  Result := FCustDics.Count;
end;

function TSpellCheck.CheckClipboardGrammar: Boolean;
// returns true if changes were made. Corrected text is on the clipboard
begin
   Result := False;
   if not FConnected then Connect;
   if not FConnected then Exit; // if still not connected then no MS Word!

   if FConnected then
   begin
      FRange.Paste; // replace with new text to check
      Result := Internal_CheckGrammar;
      if Result then FRange.Copy;
   end;
end;

function TSpellCheck.CheckClipboardSpell: Boolean;
// returns true if changes were made. Corrected text is on the clipboard
begin
   Result := False;
   if not FConnected then Connect;
   if not FConnected then Exit; // if still not connected then no MS Word!
   if FConnected then
   begin
      FRange.Paste; // replace with new text to check
      Result := Internal_checkSpelling;
      if Result then FRange.Copy; // put onto clipboard
   end;
end;

function TSpellCheck.CheckGrammar(const Text: string): Boolean;
// returns true if changes were made and the corrected text is placed in the Text string
begin
   Result := False;
   if not FConnected then Connect;
   if not FConnected then Exit; // if still not connected then no MS Word!
   if FConnected then
   begin
      FChangedText := EmptyStr;
      FRange.Text := Text; // replace with new text to check
      Result := Internal_CheckGrammar;
      if Result then FChangedText := FRange.Text;
   end;
end;

function TSpellCheck.CheckSpelling(const Text: string): Boolean;
// returns true if changes were made and the corrected text is placed in the Text string
begin
   Result := False;
   if not FConnected then Connect;
   if not FConnected then Exit; // if still not connected then no MS Word!
   if FConnected then
   begin
      FChangedText := EmptyStr;
      FRange.Text := Text; // replace with new text to check
      Result := Internal_CheckSpelling;
      if Result then FChangedText := FRange.Text;
   end
   else
      Result := False;
end;

procedure TSpellCheck.ClearText;
begin
  if FConnected then FRange.Text := EmptyStr;
end;

procedure TSpellCheck.Connect;
var
  s: string;
begin
  if FConnected then Exit; // don't create two instances
  try
    FWordApp := CreateOleObject('Word.Application');
    FConnected := True;
    FWordApp.Visible := False; // hides the application
    FWordApp.ScreenUpdating := False; // speed up winword's processing
    FWordApp.WindowState := $00000002; // minimise
    FWordDoc := FWordApp.Documents.Add(EmptyParam, False); // this will hold the text to be checked
    FRange := FWordDoc.Range;
    FRange.WholeStory; // makes FRange point to all text in document
    FCustDics := FWordApp.CustomDictionaries;
    FWordVersion := FWordApp.Version;
    s := FWordDoc.Name + ' - ' + FWordApp.Name;
    FHandle := FindWindow(MSWordWndClass, PChar(s)); // winword
    if FWordVersion[1] = '9' then
      FWordDialogClass := MSDialogWndClass2000
    else
      FWordDialogClass := MSDialogWndClass97;

    FTimer := TWordTimer.Create(True);
    FTimer.Delay := 50; // every 0.05 s
    FTimer.DialogWndClass := FWordDialogClass;
    FTimer.FreeOnTerminate := True;

  except
    FWordApp := Unassigned;
    FConnected := False;
    if Assigned(FTimer) then
    begin
      FTimer.Terminate;
      while FTimer.Suspended do
        FTimer.Resume;
    end;
    FTimer := nil;
    MessageDlg('Unable to initialise MS Word', mtError, [mbYes], 0);
  end;
end;

constructor TSpellCheck.Create(AOwner: TComponent);
var
  init: Integer;
begin
  inherited;
  FConnected := False;
  FCancel := False;
  FChangedText := EmptyStr;
  Init := CoInitialize(nil);
  if (Init = S_OK) or (Init = S_FALSE) then
    FOleOn := True
  else
    raise EOleSysError.CreateFmt('Error initialising COM library', []);

  FSpellCaption := EmptyStr;
  FUseSpellCaption := False;
  FLanguage := 0;
end;

destructor TSpellCheck.Destroy;
begin
  Disconnect;
  if FOleOn then CoUninitialize;
  inherited;
end;

procedure TSpellCheck.Disconnect;
var
  savechanges: OleVariant;
begin
  if not VarIsEmpty(FWordApp) then
  begin
    savechanges := False;
    FWordApp.Quit(savechanges); // don't save changes
    FRange := Unassigned;
    FWordDoc := Unassigned;
    FWordApp := Unassigned;
    FCustDics := Unassigned;
    FConnected := False;
    if Assigned(FTimer) then
    begin
      FTimer.Terminate;
      while FTimer.Suspended do
        FTimer.Resume; // need this in case thread was never started
    end;
    FTimer := nil;
  end;
end;

procedure TSpellCheck.RemoveCustomDic(const Name: string);
var
  dic: OleVariant;
begin
  dic := FCustDics.Item(Name);
  if not VarIsEmpty(dic) then
    dic.Delete;
  dic := Unassigned;
end;

procedure TSpellCheck.RemoveCustomDic(const Index: Integer);
var
  dic: OleVariant;
begin
  dic := FCustDics.Item(Index);
  if not VarIsEmpty(dic) then
    dic.Delete;
  dic := Unassigned;
end;

procedure TSpellCheck.ResetIgnoreAll;
begin
  if FConnected then
  begin
    FRange.Text := ''; // ResetIgnoreAll performs an automatic spell check
    FWordApp.ResetIgnoreAll;
  end;
end;

procedure TSpellCheck.SpellingOptions;
begin
  BringWindowToTop(FHandle); // ensures that dialog opens on top
  FWordApp.Dialogs.Item($000000D3).Show;
  FWordApp.Visible := False;
end;

procedure TSpellCheck.SetLanguage(Value: TSpellLanguage);
begin
  FLanguage := Value;
end;

{ TWordTimer }
procedure TWordTimer.SetDelay(Value: Integer);
begin
  if (Value > 0) then FDelay := Value;
end;

procedure TWordTimer.Execute;
var
  h: HWND;
begin
  while not Terminated do
  begin
    sleep(FDelay); // use this as a rough timer
    if (FDialogWndClass <> EmptyStr) then
    begin
      h := FindWindow(PChar(FDialogWndClass), nil);
      if (h <> 0) and (not FPopUpExists) then
      // only change caption if the window has just appeared
      begin
        SetWindowText(h, PChar(FCaption));
        FPopUpExists := True;
      end else
        FPopUpExists := False;
    end;
  end;
end;

constructor TWordTimer.Create(CreateSuspended: Boolean);
begin
  FDelay := 100; // default delay (ms)
  inherited Create(CreateSuspended);
end;

procedure TWordTimer.Resume;
begin
  FPopUpExists := False;
  inherited;
end;

end.

.Net Color codes in Delphi

Recently we had requirement where we need to show some of the dot net colours in Delphi app. So, I have converted some of the predefined .NET colour codes to Delphi Hex format. Hope you guys find it useful.
I really appreciate if you have something to add to the list. ;-)

const
  clAmber = TColor($004094FF);
  clAliceBlue = TColor($00FFF8F0);
  clAntiqueWhite = TColor($00D7EBFA);
  clAqua = TColor($00FFFF00);
  clAquamarine = TColor($00D4FF7F);
  clAzure = TColor($00FFFFF0);
  clBeige = TColor($00DCF5F5);
  clBisque = TColor($00C4E4FF);
  clBlanchedAlmond = TColor($00CDEBFF);
  clBlueViolet = TColor($00E22B8A);
  clBrown = TColor($002A2AA5);
  clBurlyWood = TColor($0087B8DE);
  clCadetBlue = TColor($00A09E5F);
  clChartreuse = TColor($0000FF7F);
  clChocolate = TColor($001E69D2);
  clCoral = TColor($00507FFF);
  clCornflowerBlue = TColor($00ED9564);
  clCornsilk = TColor($00DCF8FF);
  clCrimson = TColor($003C14DC);
  clCyan = TColor($00FFFF00);
  clDarkBlue = TColor($008B0000);
  clDarkCyan = TColor($008B8B00);
  clDarkGoldenrod = TColor($000B86B8);
  clDarkGray = TColor($00A9A9A9);
  clDarkGreen = TColor($00006400);
  clDarkKhaki = TColor($006BB7BD);
  clDarkMagenta = TColor($008B008B);
  clDarkOliveGreen = TColor($002F6B55);
  clDarkOrange = TColor($00008CFF);
  clDarkOrchid = TColor($00CC3299);
  clDarkRed = TColor($0000008B);
  clDarkSalmon = TColor($007A96E9);
  clDarkSeaGreen = TColor($008BBC8F);
  clDarkSlateBlue = TColor($008B3D48);
  clDarkSlateGray = TColor($004F4F2F);
  clDarkTurquoise = TColor($00D1CE00);
  clDarkViolet = TColor($00D30094);
  clDeepPink = TColor($009314FF);
  clDeepSkyBlue = TColor($00FFBF00);
  clDimGray = TColor($00696969);
  clDodgerBlue = TColor($00FF901E);
  clFirebrick = TColor($002222B2);
  clFloralWhite = TColor($00F0FAFF);
  clForestGreen = TColor($00228B22);
  clFuchsia = TColor($00FF00FF);
  clGainsboro = TColor($00DCDCDC);
  clGhostWhite = TColor($00FFF8F8);
  clGold = TColor($0000D7FF);
  clGoldenrod = TColor($0020A5DA);
  clGreenYellow = TColor($002FFFAD);
  clHoneydew = TColor($00F0FFF0);
  clHotPink = TColor($00B469FF);
  clIndianRed = TColor($005C5CCD);
  clIndigo = TColor($0082004B);
  clIvory = TColor($00F0FFFF);
  clKhaki = TColor($008CE6F0);
  clLavender = TColor($00FAE6E6);
  clLavenderBlush = TColor($00F5F0FF);
  clLawnGreen = TColor($0000FC7C);
  clLemonChiffon = TColor($00CDFAFF);
  clLightBlue = TColor($00E6D8AD);
  clLightCoral = TColor($008080F0);
  clLightCyan = TColor($00FFFFE0);
  clLightGoldenrodYellow = TColor($00D2FAFA);
  clLightGray = TColor($00D3D3D3);
  clLightGreen = TColor($0090EE90);
  clLightPink = TColor($00C1B6FF);
  clLightSalmon = TColor($007AA0FF);
  clLightSeaGreen = TColor($00AAB220);
  clLightSkyBlue = TColor($00FACE87);
  clLightSlateGray = TColor($00998877);
  clLightSteelBlue = TColor($00DEC4B0);
  clLightYellow = TColor($00E0FFFF);
  clLimeGreen = TColor($0032CD32);
  clLinen = TColor($00E6F0FA);
  clMediumAquamarine = TColor($00AACD66);
  clMediumBlue = TColor($00CD0000);
  clMediumOrchid = TColor($00D355BA);
  clMediumPurple = TColor($00DB7093);
  clMediumSeaGreen = TColor($0071B33C);
  clMediumSlateBlue = TColor($00EE687B);
  clMediumSpringGreen = TColor($009AFA00);
  clMediumTurquoise = TColor($00CCD148);
  clMediumVioletRed = TColor($008515C7);
  clMidnightBlue = TColor($00701919);
  clMintCream = TColor($00FAFFF5);
  clMistyRose = TColor($00E1E4FF);
  clMoccasin = TColor($00B5E4FF);
  clNavajoWhite = TColor($00ADDEFF);
  clOldLace = TColor($00E6F5FD);
  clOliveDrab = TColor($00238E6B);
  clOrange = TColor($0000A5FF);
  clOrangeRed = TColor($000045FF);
  clOrchid = TColor($00D670DA);
  clPaleGoldenrod = TColor($00AAE8EE);
  clPaleGreen = TColor($0098FB98);
  clPaleTurquoise = TColor($00EEEEAF);
  clPaleVioletRed = TColor($009370DB);
  clPapayaWhip = TColor($00D5EFFF);
  clPeachPuff = TColor($00B9DAFF);
  clPeru = TColor($003F85CD);
  clPlum = TColor($00DDA0DD);
  clPowderBlue = TColor($00E6E0B0);
  clRosyBrown = TColor($008F8FBC);
  clRoyalBlue = TColor($00E16941);
  clSaddleBrown = TColor($0013458B);
  clSalmon = TColor($007280FA);
  clSandyBrown = TColor($0060A4F4);
  clSeaGreen = TColor($00578B2E);
  clSeaShell = TColor($00EEF5FF);
  clSienna = TColor($002D52A0);
  clSkyBlue = TColor($00EBCE87);
  clSlateBlue = TColor($00CD5A6A);
  clSlateGray = TColor($00908070);
  clSnow = TColor($00FAFAFF);
  clSpringGreen = TColor($007FFF00);
  clSteelBlue = TColor($00B48246);
  clTan = TColor($008CB4D2);
  clThistle = TColor($00D8BFD8);
  clTomato = TColor($004763FF);
  clTransparent = TColor($00C8D0D4);
  clWheat = TColor($00B3DEF5);
  clWhiteSmoke = TColor($00F5F5F5);
  clYellowGreen = TColor($0032CD9A);

Draw Grabber Line on Canvas / Form

Below is the code snippet to draw a Grabber line... Its all self explainatory

const
  GrabberSize = 12;

procedure TForm1.DoPaintSidePanel();

procedure DrawGrabberLine(ALeft, ATop, ARight, ABottom: Integer);
begin
  with Canvas do
  begin
    Pen.Color := clBtnHighlight;
    MoveTo(ARight, ATop);
    LineTo(ALeft, ATop);
    LineTo(ALeft, ABottom);
    Pen.Color := clBtnShadow;
    LineTo(ARight, ABottom);
    LineTo(ARight, ATop-1);
  end;
end;
begin
  Canvas.Lock;
  try
    DrawGrabberLine(3, 12, 5, Height-2);
    DrawGrabberLine(6, 12, 8, Height-2);
  finally
    Canvas.Unlock;
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  DoPaintSidePanel();
end;

Replacing special characters from SOAP object / DB string

Finding the special characters in XML / SOAP / Database string sometimes it is painful. I've recently come across similar situation where user has copied the text from Word document and paste in Rich text editor / text editor. Error has occurred while processing the text to deserialize / saving it to database.
Code below is used to replace some known special character but you can keep adding the list if you wish.

    // Unicode function
    public static string GetUnicodeString(string s)
    {
          byte[] unicodeByte = Encoding.Unicode.GetBytes(s);
          string unicodechars = (Encoding.Default.GetString(unicodeByte)).ToString().Replace("\0", "").Replace("\f", "").Replace("", "");
          return (unicodechars);
    }

    public static string GetUnicodeString(string s, bool replaceQuotes)
    {
      //Replace MS Word quotes with standard quotes (Oracle seems to store only 7-bit ASCII)
      if (replaceQuotes)
      {
        if (s.IndexOfAny(new char[] { (char)8220, (char)8221, (char)8217, (char)8216 }) != -1)
        {
          s = s.Replace((char)8220, '\'').Replace((char)8221, '\'').Replace((char)8217, (char)34).Replace((char)8216, (char)34);
        }
      }
      return (GetUnicodeString(s));
    }
  }

Hope this helps.

Development Continues...

Cut, Copy, Paste events on TextBox & ComboBox in C# .NET

Well, I have been wondering why .NET hasn't got the Cut, Copy, Paste events on editor controls like TextBox, RichTextEditor, ListView, ComboBox and TreeView ???
Anyways, here I have got these events for you...
First we will extend / inherit the standard TextBox to TextBoxEx as in TextBoxEx.cs below

using System;
using System.ComponentModel;
using System.Data;
using System.Drawing;
using System.Globalization;
using System.Text;
using System.Windows.Forms;

namespace KurapatySolutions.Controls
{
 public partial class TextBoxEx : TextBox
 {
  #region - Constants -
  private const int WM_CUT = 0x0300;
  private const int WM_COPY = 0x0301;
  private const int WM_PASTE = 0x0302;
  #endregion

  #region - Constructor -
  public TextBoxEx()
  {
   InitializeComponent();
  }
  #endregion

  #region - Private Methods -
  private void DoOnCutText()
  {
   if (OnCutText != null)
    OnCutText(this, new ClipboardEventArgs(SelectedText));
  }
  private void DoOnCopyText()
  {
   if (OnCopyText != null)
    OnCopyText(this, new ClipboardEventArgs(SelectedText));
  }
  private void DoOnPasteText()
  {
  if (OnPasteText != null)
  OnPasteText(this, new ClipboardEventArgs(Clipboard.GetText()));
  }
  #endregion

  #region - Event Handlers -
  public event ClipboardEventHandler OnCutText;
  public event ClipboardEventHandler OnCopyText;
  public event ClipboardEventHandler OnPasteText;
  #endregion

  #region - WndProc - Handler -
  protected override void WndProc(ref Message m)
  {
   base.WndProc(ref m);
   if (m.Msg == WM_CUT)
   {
    //Cut Event
    DoOnCutText();
   }
   else if (m.Msg == WM_COPY)
   {
    //Copy Event
    DoOnCopyText();
   }
   else if (m.Msg == WM_PASTE)
   {
    //Paste Event
    DoOnPasteText();
   }   
  }
  #endregion
 }
 public class ClipboardEventArgs : EventArgs
 {
  public string ClipboardText { get; set; }

  public ClipboardEventArgs(string clipboardText)
  {
   ClipboardText = clipboardText;
  }
 }
public delegate void ClipboardEventHandler(object sender, ClipboardEventArgs e);
}

Now that the new control is ready, build your project and use the new events.

In second example, we will inherit standard ComboBox to ComboBoxEx control, this would require some kind of hacking with NativeWindow... see the code below and you will understand as its self explanatory.

using System;
using System.Runtime.InteropServices;
using System.Windows.Forms;
using System.ComponentModel;

namespace KurapatySolutions.Controls
{
 /// 

 /// ComboBox with extended functionality to support Cut, Copy & Paste events
 /// 
 public partial class ComboBoxEx : ComboBox
 {
  #region - Constants -
  private const int WM_CUT = 0x0300;
  private const int WM_COPY = 0x0301;
  private const int WM_PASTE = 0x0302;
  private const UInt32 CB_GETCOMBOBOXINFO = 0x0164;
  #endregion

  #region - DLL Import -
  [DllImport("USER32", EntryPoint = "SendMessage")]
  extern static void SendCbInfoMsg(IntPtr wnd, UInt32 msg, IntPtr wParam, [In, Out] ref ComboBoxInfo lParam);
  #endregion

  #region - Constructor -
  public ComboBoxEx()
  {
   InitializeComponent();
  }
  public ComboBoxEx(IContainer container)
  {
   container.Add(this);
   InitializeComponent();
  }
  #endregion

  #region - Private Members -
  private NativeWindowEx _nativeWindowEx;
  #endregion

  #region - Private Methods -
  private void DoOnCutText(object sender, EventArgs e)
  {
   if (OnCutText != null)
    OnCutText(sender, new ClipboardEventArgs(SelectedText));
  }
  private void DoOnCopyText(object sender, EventArgs e)
  {
   if (OnCopyText != null)
    OnCopyText(sender, new ClipboardEventArgs(SelectedText));
  }
  private void DoOnPasteText(object sender, ClipboardEventArgs e)
  {
   if (OnPasteText != null)
    OnPasteText(this, e);
  }
  #endregion

  #region - Event Handlers -
  public event ClipboardEventHandler OnCutText;
  public event ClipboardEventHandler OnCopyText;
  public event ClipboardEventHandler OnPasteText;
  #endregion
        
  #region - Private Structures & Class -
  struct Rect
  {
   public int Left;
   public int Top;
   public int Right;
   public int Bottom;
  }

  struct ComboBoxInfo
  {
   public Int32 cbSize;
   public Rect rcItem;
   public Rect rcButton;
   public Int32 buttonState;
   public IntPtr hwndCombo;
   public IntPtr hwndEdit;
   public IntPtr hwndList;
  }

  /// 

  /// This window is inherited from NativeWindow and overrides WndProc.
  /// 
  class NativeWindowEx : NativeWindow 
  {
   #region - Event Handlers -
   public event EventHandler OnCutText;
   public event EventHandler OnCopyText;
   public event ClipboardEventHandler OnPasteText;
   #endregion

   #region - Private Methods -
   private void DoOnCutText()
   {
    if (OnCutText != null)
     OnCutText(this, new EventArgs());
   }

   private void DoOnCopyText()
   {
    if (OnCopyText != null)
     OnCopyText(this, new EventArgs());
   }

   private void DoOnPasteText()
   {
    if (OnPasteText != null)
     OnPasteText(this, new ClipboardEventArgs(Clipboard.GetText()));
   }
   #endregion

   #region - WndProc - Handler -
   protected override void WndProc(ref Message m)
   {
    if (m.Msg == WM_CUT)
    {
     DoOnCutText();
    }
    if (m.Msg == WM_COPY)
    {
     DoOnCopyText();
    }
    if (m.Msg == WM_PASTE)
    {
     DoOnPasteText();
    }
    base.WndProc(ref m);
   }
   #endregion
  }
  #endregion

  #region - Overrides -
  protected override void OnHandleCreated(EventArgs e)
  {
   var cbInfo = new ComboBoxInfo();
   cbInfo.cbSize = Marshal.SizeOf(cbInfo);
   SendCbInfoMsg(Handle, CB_GETCOMBOBOXINFO, IntPtr.Zero, ref cbInfo);
   _nativeWindowEx = new NativeWindowEx();
   _nativeWindowEx.AssignHandle(cbInfo.hwndEdit);
   _nativeWindowEx.OnCutText += DoOnCutText;
   _nativeWindowEx.OnCopyText += DoOnCopyText;
   _nativeWindowEx.OnPasteText += DoOnPasteText;
   base.OnHandleCreated(e);

  }
  #endregion
 }
 public class ClipboardEventArgs : EventArgs
 {
  public string ClipboardText { get; set; }

  public ClipboardEventArgs(string clipboardText)
  {
   ClipboardText = clipboardText;
  }
 }
 public delegate void ClipboardEventHandler(object sender, ClipboardEventArgs e);
}

You can move the shared EventArgs & Delegate to EventDelegate.cs as mentioned below:

using System;

namespace KurapatySolutions.Controls
{
 public class ClipboardEventArgs : EventArgs
 {
  public string ClipboardText { get; set; }

  public ClipboardEventArgs(string clipboardText)
  {
   ClipboardText = clipboardText;
  }
 }
 public delegate void ClipboardEventHandler(object sender, ClipboardEventArgs e);
}

Hope it helps!

Development Continues...

Windows Key Combination

Not Delphi/C# this time but Windows XP -rather, for those who still using antique version ;-)
Below is the key combination with “Windows” key and press
L: Lock screen
R: Start-> Run
E: Explorer window
F: Find window
D: shows Desktop (press again to restore)
M: Minimize all (won't restore them afterwards)
Pause/Break: System properties/My Computer properties
Tab: switch between process buttons in the Taskbar (you will not notice anything on your screen, look at your taskbar and press enter to activate) and finally mutant hybrid of alt-tab is Alt-Esc

Commandline HelperClass in C#

using System;
using System.Collections.Generic;
using System.Collections.ObjectModel;
using System.Text;
using System.Text.RegularExpressions;

namespace Kurapaty.Solutions.Utils
{
	/// 

	/// Commandline Arguments Parser class
	/// 
	/// 
	/// Source: 
	/// 
	public class Arguments
	{
		/// 

		/// Splits the command line. When main(string[] args) is used escaped quotes (ie a path “c:\folder\”)
		/// Will consume all the following command line arguments as the one argument. 
		/// This function ignores escaped quotes making handling paths much easier.
		/// 
		/// The command line.		/// 
		public static string[] SplitCommandLine(string commandLine)
		{
			var translatedArguments = new StringBuilder(commandLine);
			var escaped = false;
			for (var i = 0; i < translatedArguments.Length; i++)
			{
				if (translatedArguments[i] == '"')
				{
					escaped = !escaped;
				}
				if (translatedArguments[i] == ' ' && !escaped)
				{
					translatedArguments[i] = '\n';
				}
			}

			var toReturn = translatedArguments.ToString().Split(new[] { '\n' }, StringSplitOptions.RemoveEmptyEntries);
			for (var i = 0; i < toReturn.Length; i++)
			{
				toReturn[i] = RemoveMatchingQuotes(toReturn[i]);
			}
			return toReturn;
		}

		public static string RemoveMatchingQuotes(string stringToTrim)
		{
			var firstQuoteIndex = stringToTrim.IndexOf('"');
			var lastQuoteIndex = stringToTrim.LastIndexOf('"');
			while (firstQuoteIndex != lastQuoteIndex)
			{
				stringToTrim = stringToTrim.Remove(firstQuoteIndex, 1);
				stringToTrim = stringToTrim.Remove(lastQuoteIndex - 1, 1); //-1 because we’ve shifted the indicies left by one
				firstQuoteIndex = stringToTrim.IndexOf('"');
				lastQuoteIndex = stringToTrim.LastIndexOf('"');
			}

			return stringToTrim;
		}

		private readonly Dictionary> _parameters;
		private string _waitingParameter;

		public Arguments(IEnumerable arguments)
		{
			_parameters = new Dictionary>();

			string[] parts;

			//Splits on beginning of arguments ( – and — and / )
			//And on assignment operators ( = and : )
			var argumentSplitter = new Regex(@"^-{1,2}|^/|=|:", RegexOptions.IgnoreCase | RegexOptions.Compiled);

			foreach (var argument in arguments)
			{
				parts = argumentSplitter.Split(argument, 3);
				switch (parts.Length)
				{
					case 1:
						AddValueToWaitingArgument(parts[0]);
						break;
					case 2:
						AddWaitingArgumentAsFlag();

						//Because of the split index 0 will be a empty string
						_waitingParameter = parts[1];
						break;
					case 3:
						AddWaitingArgumentAsFlag();

						//Because of the split index 0 will be a empty string
						string valuesWithoutQuotes = RemoveMatchingQuotes(parts[2]);

						AddListValues(parts[1], valuesWithoutQuotes.Split(','));
						break;
				}
			}

			AddWaitingArgumentAsFlag();
		}

		private void AddListValues(string argument, IEnumerable values)
		{
			foreach (var listValue in values)
			{
				Add(argument, listValue);
			}
		}

		private void AddWaitingArgumentAsFlag()
		{
			if (_waitingParameter == null) return;

			AddSingle(_waitingParameter, "true");
			_waitingParameter = null;
		}

		private void AddValueToWaitingArgument(string value)
		{
			if (_waitingParameter == null) return;

			value = RemoveMatchingQuotes(value);

			Add(_waitingParameter, value);
			_waitingParameter = null;
		}

		/// 

		/// Gets the count.
		/// 
		/// The count.
		public int Count
		{
			get
			{
				return _parameters.Count;
			}
		}

		/// 

		/// Adds the specified argument.
		/// 
		/// The argument.		/// The value.		public void Add(string argument, string value)
		{
			if (!_parameters.ContainsKey(argument))
				_parameters.Add(argument, new Collection());

			_parameters[argument].Add(value);
		}

		public void AddSingle(string argument, string value)
		{
			if (!_parameters.ContainsKey(argument))
				_parameters.Add(argument, new Collection());
			else
				throw new ArgumentException(string.Format("Argument {0} has already been defined", argument));

			_parameters[argument].Add(value);
		}

		public void Remove(string argument)
		{
			if (_parameters.ContainsKey(argument))
				_parameters.Remove(argument);
		}

		/// 

		/// Determines whether the specified argument is true.
		/// 
		/// The argument.		/// 
		///     true if the specified argument is true; otherwise, false.
		/// 
		public bool IsTrue(string argument)
		{
			AssertSingle(argument);

			var arg = this[argument];

			return arg != null && arg[0].Equals("true", StringComparison.OrdinalIgnoreCase);
		}

		public bool IsExists(string argument)
		{
			return IsTrue(argument);
		}

		private void AssertSingle(string argument)
		{
			if (this[argument] != null && this[argument].Count > 1)
				throw new ArgumentException(string.Format("{0} has been specified more than once, expecting single value", argument));
		}

		public string Single(string argument)
		{
			AssertSingle(argument);

			//only return value if its NOT true, there is only a single item for that argument
			//and the argument is defined
			if (this[argument] != null && !IsTrue(argument))
				return this[argument][0];

			return null;
		}

		public bool Exists(string argument)
		{
			return (this[argument] != null && this[argument].Count > 0);
		}

		/// 

		/// Gets the  with the specified parameter.
		/// 
		/// 
		public Collection this[string parameter]
		{
			get
			{
				return _parameters.ContainsKey(parameter) ? _parameters[parameter] : null;
			}
		}
	}
}

Usage:

		private bool ProcessCommandLineParameters()
		{
			// Usage: -ec -source:"C:\Temp\formDefinition.txt" -target:"C:\Temp\formDefinition.enc"
			try
			{
				Arguments parser = new Arguments(Arguments.SplitCommandLine(Environment.CommandLine));

				if (parser.IsExists("help") || parser.IsExists("?"))
					ShowUsageHelpMessage();

				if (parser.Exists("source") && 1 == parser["source"].Count) tbSource.Text = parser.Single("source");
				if (parser.Exists("target") && 1 == parser["target"].Count) tbTarget.Text = parser.Single("target");

				if (parser.Exists("ec") && parser.IsTrue("ec"))
				{
					button1_Click(null, null);
					return true;
				}
				if (parser.Exists("dc") && parser.IsTrue("dc"))
				{
					button2_Click(null, null);
					return true;
				}
			}
			catch (Exception)
			{
				MessageBox.Show("Invalid commandline arguments passed. Please use GUI or type \"help\" at commandline.",
				                "Commandline processor", MessageBoxButtons.OK, MessageBoxIcon.Information);
			}
			return false;
		}

Delphi 6 Commandline Helper Class

unit uCmdLineHelper;

interface

uses Windows, Classes, SysUtils;

  type
  TCommandLineHelper = class(TObject)
  private
    function GetNextParam(var CmdLine: PChar; Buffer: PChar; Len: PInteger): Boolean;
    function GetParamCount: Integer;
    function GetCommandLine: string;
    function GetParamStr(Index: Integer): String;
    function GetHasParam(Value: String): Boolean;
  public
    property ParamStr[Index: Integer]: String read GetParamStr;
    property ParamCount: Integer read GetParamCount;
    property CommandLine: String read GetCommandLine;
    property HasParam[Value: String]: Boolean read GetHasParam;
  end;

implementation


function TCommandLineHelper.GetCommandLine : string;
begin
  result := Windows.GetCommandLine;
end;

function TCommandLineHelper.GetHasParam(Value: String): Boolean;
var
 I: Integer;
 param: String;
begin
  result := False;
  for I:= 1 to ParamCount do
  begin
    param := UpperCase(ParamStr[I]);
    Value := UpperCase(Value);
    result := ((param = Value) or
               (param = '/'+Value) or ('/'+param = Value) or
               (param = '\'+Value) or ('\'+param = Value) or
               (param = '-'+Value) or ('-'+param = Value) or
               (param = ':'+Value) or (':'+param = Value));
    if result then Exit;
  end;
end;

function TCommandLineHelper.GetNextParam(var CmdLine: PChar; Buffer: PChar; Len: PInteger): Boolean;
var
  InQuotedStr, IsOdd: Boolean;
  NumSlashes, NewLen, cnt: Integer;
begin
  Result := False;
  if Len <> nil then Len^ := 0;
  if CmdLine = nil then Exit;

  while (CmdLine^ <= ' ') and (CmdLine^ <> #0) do CmdLine := CharNext(CmdLine) ;
  if CmdLine^ = #0 then Exit;

  InQuotedStr := False;
  NewLen := 0;
  repeat
    if CmdLine^ = '\' then
    begin
      NumSlashes := 0;
      repeat
        Inc(NumSlashes) ;
        CmdLine := CharNext(CmdLine) ;
      until CmdLine^ <> '\';

      if CmdLine^ = '"' then
      begin
        IsOdd := (NumSlashes mod 2) <> 0;
        NumSlashes := NumSlashes div 2;
        Inc(NewLen, NumSlashes) ;

        if IsOdd then Inc(NewLen);

        if Buffer <> nil then
        begin
          for cnt := 0 to NumSlashes-1 do
          begin
            Buffer^ := '\';
            Inc(Buffer) ;
          end;

          if IsOdd then
          begin
            Buffer^ := '"';
            Inc(Buffer) ;
          end;
        end;
        if IsOdd then CmdLine := CharNext(CmdLine) ;
      end else
      begin
        Inc(NewLen, NumSlashes);

        if Buffer <> nil then
        begin
          for cnt := 0 to NumSlashes-1 do
          begin
            Buffer^ := '\';
            Inc(Buffer) ;
          end;
        end;
      end;
      Continue;
    end;
    if CmdLine^ <> '"' then
    begin
      if (CmdLine^ <= ' ') and (not InQuotedStr) then Break;
      Inc(NewLen) ;
      if Buffer <> nil then
      begin
        Buffer^ := CmdLine^;
        Inc(Buffer) ;
      end;
    end
    else
      InQuotedStr := not InQuotedStr;
    CmdLine := CharNext(CmdLine) ;
  until CmdLine^ = #0;
  if Len <> nil then Len^ := NewLen;
  Result := True;
end;

function TCommandLineHelper.GetParamCount: Integer;
var
  CmdLine: PChar;
begin
  Result := 0;
  CmdLine := Windows.GetCommandLine;
  GetNextParam(CmdLine, nil, nil) ;
  while GetNextParam(CmdLine, nil, nil) do Inc(Result) ;
end;

function TCommandLineHelper.GetParamStr(Index: Integer): String;
var
  Buffer: array[0..MAX_PATH] of Char;
  CmdLine, P: PChar;
  Len: Integer;
begin
  Result := '';
  if Index <= 0 then
  begin
    Len := GetModuleFileName(0, Buffer, MAX_PATH+1) ;
    SetString(Result, Buffer, Len) ;
  end else
  begin
    CmdLine := windows.GetCommandLine;
    GetNextParam(CmdLine, nil, nil) ;
    repeat
      Dec(Index) ;
      if Index = 0 then Break;
      if not GetNextParam(CmdLine, nil, nil) then Exit;
    until False;
    P := CmdLine;
    if GetNextParam(P, nil, @Len) then
    begin
      SetLength(Result, Len) ;
      GetNextParam(CmdLine, PChar(Result), nil) ;
    end;
  end;
end;

end.

Usage:

var
  idx : integer;
  helper: TCommandLineHelper;
begin
  helper:= TCommandLineHelper.Create;
  with Memo1.Lines do
  begin
    Clear;

    Add('CMD Line: ' + helper.CommandLine + #13#10) ;
    Add('Number of params: ' + IntToStr(helper.ParamCount) + #13#10) ;

    for idx := 1 to helper.ParamCount do
    begin
      Memo1.Lines.Add(helper.ParamStr[idx]) ;
    end;
      Memo1.Lines.Add('Has Param - and ? '+ BoolToStr(helper.HasParam['third'], true));
  end;
  helper.Free;
end;