{------------------------------------------------------------------------
Procedure: StringFormat
Author: Kiran Kurapaty
Date: 02-Jan-2011
Arguments: const AFormat: string; AParams: array of const
Result: string
Usage: ShowMessage(StringFormat( 'Records ({0}) {1} in {2} mins {3} secs ', [123, 'loaded.', varMins, varSecs]);
-------------------------------------------------------------------------}
function StringFormat(const AFormat: string; AParams: array of const): string;
function GetAsString(varRec: TVarRec): String;
begin
try
case varRec.VType of
vtAnsiString: result := varRec.VPChar;
vtBoolean: result := IfThen(varRec.VBoolean, 'True', 'False');
vtChar: result := varRec.VChar;
vtClass: result := varRec.VClass.ClassName;
vtCurrency: result := format('%m', [varRec.VCurrency^]);
vtExtended: result := format('%f', [varRec.VExtended^]);
vtInt64: result := format('%d', [varRec.VInt64^]);
vtInteger: result := format('%d', [varRec.VInteger]);
vtInterface: result := format('%p', [varRec.VPointer]);
vtObject: result := varRec.VObject.ClassName;
vtPChar: result := varRec.VPChar;
vtPointer: result := format('%p', [varRec.VPointer]);
vtPWideChar: result := varRec.VPWideChar;
vtString: result := varRec.VPChar;
vtVariant: result := varRec.VVariant^;
vtWideChar: result := varRec.VWideChar;
vtWideString: result := varRec.VPWideChar;
end;
except
Result := 'Unknown';
end;
end;
var
I: Integer;
itemVal: string;
begin
Result := AFormat;
for I := Low(AParams) to High(AParams) do
begin
itemVal := GetAsString(AParams[I]);
Result := StringReplace(Result, Format('{%d}', [I+1]), itemVal, [rfReplaceAll]);
end;
end;
Wednesday, October 12, 2011
.Net string.format to Delphi StringFormat
Well I have been busy working in .NET and thought to add "string.format" functionality in Delphi. I am not quite sure if this functionality exists in new versions of Delphi??? AFAIK, this is not available until D7.
Wednesday, December 01, 2010
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.
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!
- 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.
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.
Friday, November 26, 2010
.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. ;-)
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;
Monday, August 16, 2010
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.
Development Continues...
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...
Thursday, August 12, 2010
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
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.
You can move the shared EventArgs & Delegate to EventDelegate.cs as mentioned below:
Hope it helps!
Development Continues...
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...
Tuesday, July 06, 2010
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
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
Friday, March 26, 2010
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. /// > _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.
///
/// 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;
Subscribe to:
Posts (Atom)