I want to check and see if the TEdit.text is in this format 123/45/678 When text was entered
Thus ###/##/###
any simple way to do this?
thanks
Function CheckStringWithMask(const Str,Mask:String):Boolean;
var
i:Integer;
begin
Result := true;
if length(str)=length(Mask) then
begin
i := 0;
While Result and (I < Length(Str)) do
begin
inc(i);
Result := Result and (Str[i] <> '#')
and ((Mask[i] ='#') and (CharInSet(Str[i],['0'..'9']))
or (Str[i]=Mask[i]));
end;
end
else Result := false;
end;
Assuming your mask is so simple that it only has # and / it's easy to write a test function:
function MatchesMask(const Text, Mask: string): Boolean;
var
i: Integer;
begin
Result := False;
if Length(Text)<>Length(Mask) then
exit;
for i := 1 to Length(Text) do
case Mask[i] of
'#':
if (Text[i]<'0') or (Text[i]>'9') then
exit;
else
if Text[i]<>Mask[i] then
exit;
end;
Result := True;
end;
A variation on #David Heffernan's suggestion:
function MatchesMask(const Text, Mask: string): Boolean;
var
i: Integer;
begin
Result := (Length(Text) = Length(Mask));
if not Result then Exit;
i := 0;
while Result and (i < Length(Text)) do begin
Inc(i);
case Mask[i] of
'#':
Result := (Text[i] >= '0') and (Text[i] <= '9');
else
Result := (Text[i] = Mask[i]);
end;
end;
end;
Related
I have saved my TreeView inside my DataBase by using the next :
var
BlobField :TField;
Query:TADOQuery;
Stream:TStream;
...
try
Query.SQL.Text := 'Select TOP(1) * From MyTable';
DBQueryConnect(Query); // I used this Procedure to connect the Query to the database
try
Query.First;
Query.Edit;
try
BlobField := Query.FieldByName('MyField') as TField;
Stream := Query.CreateBlobStream(BlobField, bmWrite);
try
MyTreeView.SaveToStream(Stream,TEncoding.UTF8);
finally
Stream.Free;
end;
Query.Post;
except
Query.Cancel;
raise;
end;
finally
Query.Close;
end;
finally
Query.Free;
end;
end;
and I loaded back the TTreeView form the DataBase by using the next :
...
var
Query:TADOQuery;
Stream:TStream;
begin
Query:=TADOQuery.Create(Self);
try
Query.SQL.Add('Select * From MyTable') ;
DBQueryConnect(Query);
Query.First;
Stream:=Query.CreateBlobStream(Query.FieldByName('MyField'), bmread);
MyTreeView.LoadFromStream(Stream);
Stream.Free;
finally
Query.Free;
end;
how can I retrive the imageindex for my TreeView items from the saved data ..
Thank you .
Perharps we can modify exsisting SaveTreeToStream and LoadTreeFromStream like this :
function GetBufStart(Buffer,idxSeparator: string; var Level,ImageIndex: Integer): string;
var
Pos: Integer;
sidx:String;
begin
Pos := 1;
Level := 0;
ImageIndex := -1;
while (CharInSet(Buffer[Pos], [' ', #9])) do
begin
Inc(Pos);
Inc(Level);
end;
Result := Copy(Buffer, Pos, Length(Buffer) - Pos + 1);
//Check Image Index
pos:=System.SysUtils.AnsiPos(idxSeparator,Result);
if Pos>0 then begin
sidx:=copy(result,Pos + Length(idxSeparator), length(result) - Pos + 1);
ImageIndex := StrToIntDef(sidx,-1);
Result := Copy(Result, 1, Pos - 1);
end;
end;
procedure LoadTreeFromStream(Nodes:TTreeNodes; Stream:TStream; Encoding:TEncoding; idxSeparator:String='|||');
var
List: TStringList;
ANode, NextNode: TTreeNode;
ALevel, i, ImageIndex: Integer;
CurrStr: string;
begin
List := TStringList.Create;
Nodes.BeginUpdate;
try
try
Nodes.Clear;
List.LoadFromStream(Stream, Encoding);
ANode := nil;
for i := 0 to List.Count - 1 do
begin
CurrStr := GetBufStart(PChar(List[i]), idxSeparator, ALevel, ImageIndex);
if ANode = nil then
ANode := Nodes.AddChild(nil, CurrStr)
else if ANode.Level = ALevel then
ANode := Nodes.AddChild(ANode.Parent, CurrStr)
else if ANode.Level = (ALevel - 1) then
ANode := Nodes.AddChild(ANode, CurrStr)
else if ANode.Level > ALevel then
begin
NextNode := ANode.Parent;
while NextNode.Level > ALevel do
NextNode := NextNode.Parent;
ANode := Nodes.AddChild(NextNode.Parent, CurrStr);
end
else raise Exception.CreateFmt('Invalid level (%d) for item "%s"', [ALevel, CurrStr]);
ANode.ImageIndex:=ImageIndex;
end;
finally
Nodes.EndUpdate;
List.Free;
end;
except
Nodes.Owner.Invalidate; // force repaint on exception
raise;
end;
end;
procedure SaveTreeToStream(Nodes:TTreeNodes; Stream:Tstream; Encoding:TEncoding; idxSeparator:String='|||');
const
TabChar = #9;
EndOfLine = #13#10;
var
I: Integer;
ANode: TTreeNode;
NodeStr: TStringBuilder;
Buffer, Preamble: TBytes;
begin
if Nodes.Count > 0 then
begin
if Encoding = nil then
Encoding := TEncoding.Default;
//Buffer := Encoding.GetBytes('');
Preamble := Encoding.GetPreamble;
if Length(Preamble) > 0 then
Stream.WriteBuffer(Preamble{$IFNDEF CLR}[0]{$ENDIF}, Length(Preamble));
NodeStr := TStringBuilder.Create(1024);
try
ANode := Nodes[0];
while ANode <> nil do
begin
NodeStr.Length := 0;
for I := 0 to ANode.Level - 1 do
NodeStr.Append(TabChar);
NodeStr.Append(ANode.Text);
NodeStr.Append(idxSeparator);
NodeStr.Append(ANode.ImageIndex);
NodeStr.Append(EndOfLine);
Buffer := Encoding.GetBytes(NodeStr.ToString);
Stream.Write(Buffer{$IFNDEF CLR}[0]{$ENDIF}, Length(Buffer));
ANode := ANode.GetNext;
end;
finally
NodeStr.Free;
end;
end;
end;
You can replace
MyTreeView.SaveToStream(Stream,TEncoding.UTF8);
with
SaveTreeToStream(MyTreeView.Items,Stream,TEncoding.UTF8);
and MyTreeView.LoadFromStream(Stream); with LoadTreeFromStream(MyTreeView.Items,Stream,TEncoding.UTF8);
I'm trying to create a function that is similar to Delphi's pos function, but that i could pass different strings to be searched, instead of only one. So i could call the function like this :
multipos('word1#word2#word3','this is a sample text with word2',false);
// will return 'word2'
The function would return which string was found.
The code i did is below and it's working but it's too slow. How could i improve the speed of this code ?
function multipos(needles,key: string; requireAll: boolean): string;
var
k: array [1 .. 50] of string;
i, j: integer;
r, aux: string;
flag: boolean;
begin
if trim(key) = '' then
Result := ''
else
try
r := '';
Result := '';
j := 1;
for i := 1 to 50 do
k[i] := '';
for i := 1 to length(needles) do
begin
if needles[i] <> '#' then
aux := aux + needles[i]
else
begin
k[j] := aux;
Inc(j);
aux := '';
end;
if j >= 50 then
break;
end;
if aux <> '' then
k[j] := aux;
for i := 1 to j do
begin
if k[i] = '' then
break
else
if pos(lowercase(k[i]), lowercase(key)) > 0 then
begin
if not requireAll then
begin
Result := k[i];
break;
end
else
begin
r := r + k[i] + ',';
flag := i = j;
if not flag then
flag := k[i + 1] = '';
if flag then
begin
Result := r;
end;
end;
end
else
if requireAll then
begin
break;
end;
end;
except
on e: exception do
begin
Result := '';
end;
end;
end;
Consider to pass the items as an array, like:
function Multipos(const A: array of string; const S: string): string;
begin
for var E in A do
if Pos(E, S) > 0 then
Exit(E);
Result := ''; // Nothing found
end;
// sample calls
Multipos(['word1', 'word2', 'word3'], 'sample text with word2');
Multipos('word1#word2#word3'.Split(['#']), 'sample text with word2');
To implement RequireAll functionality, stop on first failure. Just check what to return in that case.
Also, TStrings/TStringList could work for your needs. Check it's Delimiter and DelimitedText properties.
As you didn't specify a Delphi version, I simply assume the latest:
function multipos(const needles,key: string; requireAll: boolean): string;
var
lst: TStringList;
begin
lst := TStringList.Create;
try
var lowerkey := key.ToLower; // do this only once
for var needle in needles.Split(['#']) do begin
if lowerkey.Contains(needle.ToLower) then begin
if not requireAll then
Exit(needle);
lst.Add(needle);
end;
end;
Result := lst.CommaText;
finally
lst.Free;
end;
end;
The array solution by Marcodor is good. Here is a TStringList alternative:
function multipos(SubStrs: TStringList; Str: string; RequireAll: Boolean): string;
var
i: Integer;
begin
if (not Str.IsEmpty) and (not SubStrs.Count < 1) then
begin
Result := '';
for i := 0 to SubStrs.Count - 1 do
if Pos(SubStrs[i], Str) > 0 then
Result := Result + Copy(Str, Pos(SubStrs[i], Str), SubStrs[i].Length)
else if RequireAll then
Result := '';
end;
end;
var
myList: TStringList;
begin
myList := TStringList.Create;
myList.Delimiter := '#';
myList.DelimitedText := 'word1#word2#word3';
Writeln(multipos(myList, 'this word1is a sample word3 text with word2', False));
end.
Obviously you'll need system.classes for the StringList. And perhaps some better checking if everything is in order before accessing the parameters, but it works for RequireAll True and False.
I am having trouble getting the serial port data from an equipment.
Below is the image of the expected result:
Desire result:
Unwanted result:
I use Ttimer so I can automatically get the data and put it to the Memo.
I need the data to be placed line by line in the memo.
This is the source code:
procedure TForm3.Timer1Timer(Sender: TObject);
var
k: Integer;
InBuffer: array[1..500] of char;
begin
for k:=1 to 500 do
InBuffer[k]:=' ';
Trim(InBuffer);
if cport.Connected = true then
begin
ComLed1.Kind := lkGreenLight;
cport.ReadStr(str,k);
Trim(str);
S:=str;
if str = '' then
begin
end
else
begin
memo1.lines.Add(str);
end;
end
else
begin
ComLed1.Kind := lkredLight;
txt_com_status1.Caption := 'Connected';
end;
end;
My question is what is the problem? And what is the solution for this.
TMemo.Lines.Add() adds a line. The text you add will have a line break inserted at the end of it. It is clear that you are receiving the hardware data in pieces, and you are adding each piece separately as its own line in the Memo.
To do what you are attempting, you need to either:
Read the pieces from the hardware and cache them until you detect the end of a complete message, and then Add() only complete messages to the Memo. How you do this depends on the particular protocol the hardware is using to send data to you. Does it wrap the data in STX/ETX markers? Does it delimit messages? We don't know, you have not provided any information about that. And your code is trying (unsuccessfully) to trim a lot of data away that it probably shouldn't be throwing away at all.
Don't use Add() at all. You can use the SelText property instead to avoid inserting any line breaks you don't want.
memo1.SelStart := memo1.GetTextLen;
memo1.SelLength := 0;
memo1.SelText := str;
That being said, your timer code is doing some odd things. InBuffer is filled with spaces, then (unsuccessfully) trimmed, and then completely ignored. You are passing an uninitialized k value to ReadStr(). The str value you do read is unsuccessfully trimmed before added to the Memo. You are assigning str to S and then ignoring S.
Try this instead:
procedure TForm3.Timer1Timer(Sender: TObject);
var
str: AnsiString;
begin
if cport.Connected then
begin
ComLed1.Kind := lkGreenLight;
txt_com_status1.Caption := 'Connected';
cport.ReadStr(str, 256);
str := Trim(str);
if str <> '' then
begin
memo1.SelStart := memo1.GetTextLen;
memo1.SelLength := 0;
memo1.SelText := str;
end;
end
else
begin
ComLed1.Kind := lkredLight;
txt_com_status1.Caption := 'Disconnected';
end;
end;
Alternatively (assuming you are using TComPort that has an OnRxChar event):
procedure TForm3.Timer1Timer(Sender: TObject);
begin
if cport.Connected then
begin
ComLed1.Kind := lkGreenLight;
txt_com_status1.Caption := 'Connected';
end
else
begin
ComLed1.Kind := lkredLight;
txt_com_status1.Caption := 'Disconnected';
end;
end;
procedure TForm3.cportRxChar(Sender: TObject; Count: Integer);
var
str: AnsiString;
begin
cport.ReadStr(str, Count);
str := Trim(str);
if str <> '' then
begin
memo1.SelStart := memo1.GetTextLen;
memo1.SelLength := 0;
memo1.SelText := str;
end;
end;
Edit based on new information provided in comments, try something like this:
private
buffer: AnsiString;
portConnected: boolean;
procedure TForm3.Timer1Timer(Sender: TObject);
begin
if cport.Connected then
begin
if not portConnected then
begin
portConnected := true;
buffer := '';
ComLed1.Kind := lkGreenLight;
txt_com_status1.Caption := 'Connected';
end;
end
else
begin
if portConnected then
begin
portConnected := false;
ComLed1.Kind := lkredLight;
txt_com_status1.Caption := 'Disconnected';
end;
end;
end;
procedure TForm3.cportRxChar(Sender: TObject; Count: Integer);
var
str: AnsiString;
i: integer;
begin
cport.ReadStr(str, Count);
buffer := buffer + str;
repeat
i := Pos(#10, buffer);
if i = 0 then Exit;
str := Copy(buffer, 1, i-1);
Delete(buffer, 1, i);
memo1.Lines.Add(str);
until buffer = '';
end;
In Delphi XE7, I use this code to create a SHELL LINK pointing to a specific folder. This folder is displayed in Windows Explorer with a custom folder icon defined by a desktop.ini file inside this folder. The SHELL LINK should be created with the icon parameters found in the desktop.ini file, i.e. pointing to the same icon resource as the desktop.ini file. So here is the code:
function GetDesktopIniIconDataFromFolder(const APath: string; var VIconIndex: Integer): string;
var
DeskTopIniFile: string;
DesktopIni: System.IniFiles.TIniFile;
ThisIconFileStr, ThisIconIndexStr: string;
ThisIconIndexInt: Integer;
begin
Result := '';
if DirectoryExists(APath) then
begin
DeskTopIniFile := IncludeTrailingPathDelimiter(APath) + 'Desktop.ini';
if FileExists(DeskTopIniFile) then
begin
DesktopIni := System.IniFiles.TIniFile.Create(DeskTopIniFile);
try
ThisIconFileStr := DesktopIni.ReadString('.ShellClassInfo', 'IconFile', '');
if ThisIconFileStr <> '' then
begin
ThisIconIndexStr := DesktopIni.ReadString('.ShellClassInfo', 'IconIndex', '');
if ThisIconIndexStr <> '' then
begin
ThisIconIndexInt := System.SysUtils.StrToIntDef(ThisIconIndexStr, MaxInt);
if ThisIconIndexInt <> MaxInt then
begin
Result := ThisIconFileStr;
VIconIndex := ThisIconIndexInt;
end;
end;
end;
finally
DesktopIni.Free;
end;
end;
end;
end;
function MyCreateShellLink(const LinkFileName, AssocFileName, Desc, WorkDir,
Args, IconFileName: string; const IconIdx: Integer): Boolean;
var
SL: Winapi.ShlObj.IShellLink;
PF: Winapi.ActiveX.IPersistFile;
begin
Result := False;
Winapi.ActiveX.CoInitialize(nil);
try
if Winapi.ActiveX.Succeeded(
Winapi.ActiveX.CoCreateInstance(
Winapi.ShlObj.CLSID_ShellLink,
nil,
Winapi.ActiveX.CLSCTX_INPROC_SERVER,
Winapi.ShlObj.IShellLink, SL
)
) then
begin
SL.SetPath(PChar(AssocFileName));
SL.SetDescription(PChar(Desc));
SL.SetWorkingDirectory(PChar(WorkDir));
SL.SetArguments(PChar(Args));
if (IconFileName <> '') and (IconIdx >= 0) then
SL.SetIconLocation(PChar(IconFileName), IconIdx);
PF := SL as Winapi.ActiveX.IPersistFile;
Result := Winapi.ActiveX.Succeeded(
PF.Save(PWideChar(WideString(LinkFileName)), True)
);
end;
finally
Winapi.ActiveX.CoUninitialize;
end;
end;
// Usage:
var
IconFile: string;
IconIndex: Integer;
begin
IconFile := GetDesktopIniIconDataFromFolder(APath, IconIndex);
if IconFile <> '' then
MyCreateShellLink(ALinkFileName, ATargetFileName, ADescription, AWorkDir, AArgs, IconFile, IconIndex);
This works well, EXCEPT in cases where the IconIndex in the desktop.ini file is a negative value (which means the negative value indicates a resource ID rather than an ordinal value), like in this example:
[.ShellClassInfo]
InfoTip=#Shell32.dll,-12688
IconFile=%SystemRoot%\system32\mydocs.dll
IconIndex=-101
In this case the created SHELL LINK is erroneous, which means the Shell LINK does not contain the correct icon reference.
So how can I translate the negative IconIndex value -101 from the desktop.ini file to a value I can use in the MyCreateShellLink function?
If you want to use negative IconIndex then pass FULL path of icon to SetIconLocation. Use the following variant of GetDesktopIniIconDataFromFolder:
function GetDesktopIniIconDataFromFolder(const APath: string; var AIconIndex: Integer): string;
var
Setting: TSHFolderCustomSettings;
begin
ZeroMemory(#Setting, SizeOf(Setting));
Setting.dwSize := SizeOf(Setting);
Setting.dwMask := FCSM_ICONFILE;
SetLength(Result, MAX_PATH + 1);
Setting.pszIconFile := PChar(Result);
Setting.cchIconFile := MAX_PATH;
if Succeeded(SHGetSetFolderCustomSettings(#Setting, PChar(APath), FCS_READ)) then
begin
Result := PChar(Result);
AIconIndex := Setting.iIconIndex;
end
else
Result := '';
end;
It automatically expands variables of icon path. Also it supports IconResource parameter of desktop.ini.
Variant 2 (universal)
function GetObjectIconFileName(AParentWnd: HWND; const AName: UnicodeString; var AIndex: Integer): UnicodeString;
var
Desktop: IShellFolder;
Attr: DWORD;
Eaten: DWORD;
IDList: PItemIDList;
Parent: IShellFolder;
Child: PItemIDList;
ExtractIconW: IExtractIconW;
ExtractIconA: IExtractIconA;
AnsiResult: AnsiString;
Flags: DWORD;
Ext: UnicodeString;
BuffSize: DWORD;
P: Integer;
begin
OleCheck(SHGetDesktopFolder(Desktop));
try
Attr := SFGAO_STREAM;
OleCheck(Desktop.ParseDisplayName(AParentWnd, nil, PWideChar(AName), Eaten, IDList, Attr));
try
OleCheck(SHBindToParent(IDList, IShellFolder, Pointer(Parent), Child));
if Succeeded(Parent.GetUIObjectOf(AParentWnd, 1, Child, IExtractIconW, nil, ExtractIconW)) then
try
SetLength(Result, MAX_PATH + 1);
if (ExtractIconW.GetIconLocation(0, PWideChar(Result), MAX_PATH, AIndex, Flags) = S_OK) then
begin
Result := PWideChar(Result);
if // (Flags and GIL_NOTFILENAME = 0) and // Dont know why shell return GIL_NOTFILENAME flag
FileExists(Result) then
Exit
else
Result := '';
end
else
Result := '';
finally
ExtractIconW := nil;
end
else
if Succeeded(Parent.GetUIObjectOf(AParentWnd, 1, Child, IExtractIconA, nil, ExtractIconA)) then
try
SetLength(AnsiResult, MAX_PATH + 1);
if (ExtractIconA.GetIconLocation(0, PAnsiChar(AnsiResult), MAX_PATH, AIndex, Flags) = S_OK) then
begin
Result := UnicodeString(PAnsiChar(AnsiResult));
if // (Flags and GIL_NOTFILENAME = 0) and // Dont know why shell return GIL_NOTFILENAME flag
FileExists(Result) then
Exit
else
Result := '';
end
else
Result := '';
finally
ExtractIconA := nil;
end;
finally
CoTaskMemFree(IDList);
end;
finally
Desktop := nil;
end;
if Attr and SFGAO_STREAM <> 0 then
begin
Ext := ExtractFileExt(AName);
if (AssocQueryStringW(ASSOCF_NONE, ASSOCSTR_DEFAULTICON, PWideChar(Ext), nil, nil, #BuffSize) = S_FALSE) and (BuffSize > 1) then
begin
SetLength(Result, BuffSize - 1);
if Succeeded(AssocQueryStringW(ASSOCF_NONE, ASSOCSTR_DEFAULTICON, PWideChar(Ext), nil, PWideChar(Result), #BuffSize)) then
begin
AIndex := 0;
P := LastDelimiter(',', Result);
if P > 0 then
begin
AIndex := StrToIntDef(Copy(Result, P + 1, MaxInt), MaxInt);
if AIndex <> MaxInt then
Delete(Result, P, MaxInt)
else
AIndex := 0;
end;
Exit;
end;
end;
end;
Result := '';
end;
Has anyone written an 'UnFormat' routine for Delphi?
What I'm imagining is the inverse of SysUtils.Format and looks something like this
UnFormat('a number %n and another %n',[float1, float2]);
So you could unpack a string into a series of variables using format strings.
I've looked at the 'Format' routine in SysUtils, but I've never used assembly so it is meaningless to me.
This is called scanf in C, I've made a Delphi look-a-like for this :
function ScanFormat(const Input, Format: string; Args: array of Pointer): Integer;
var
InputOffset: Integer;
FormatOffset: Integer;
InputChar: Char;
FormatChar: Char;
function _GetInputChar: Char;
begin
if InputOffset <= Length(Input) then
begin
Result := Input[InputOffset];
Inc(InputOffset);
end
else
Result := #0;
end;
function _PeekFormatChar: Char;
begin
if FormatOffset <= Length(Format) then
Result := Format[FormatOffset]
else
Result := #0;
end;
function _GetFormatChar: Char;
begin
Result := _PeekFormatChar;
if Result <> #0 then
Inc(FormatOffset);
end;
function _ScanInputString(const Arg: Pointer = nil): string;
var
EndChar: Char;
begin
Result := '';
EndChar := _PeekFormatChar;
InputChar := _GetInputChar;
while (InputChar > ' ')
and (InputChar <> EndChar) do
begin
Result := Result + InputChar;
InputChar := _GetInputChar;
end;
if InputChar <> #0 then
Dec(InputOffset);
if Assigned(Arg) then
PString(Arg)^ := Result;
end;
function _ScanInputInteger(const Arg: Pointer): Boolean;
var
Value: string;
begin
Value := _ScanInputString;
Result := TryStrToInt(Value, {out} PInteger(Arg)^);
end;
procedure _Raise;
begin
raise EConvertError.CreateFmt('Unknown ScanFormat character : "%s"!', [FormatChar]);
end;
begin
Result := 0;
InputOffset := 1;
FormatOffset := 1;
FormatChar := _GetFormatChar;
while FormatChar <> #0 do
begin
if FormatChar <> '%' then
begin
InputChar := _GetInputChar;
if (InputChar = #0)
or (FormatChar <> InputChar) then
Exit;
end
else
begin
FormatChar := _GetFormatChar;
case FormatChar of
'%':
if _GetInputChar <> '%' then
Exit;
's':
begin
_ScanInputString(Args[Result]);
Inc(Result);
end;
'd', 'u':
begin
if not _ScanInputInteger(Args[Result]) then
Exit;
Inc(Result);
end;
else
_Raise;
end;
end;
FormatChar := _GetFormatChar;
end;
end;
I know it tends to scare people, but you could write a simple function to do this using regular expressions
'a number (.*?) and another (.*?)
If you are worried about reg expressions take a look at www.regexbuddy.com and you'll never look back.
I tend to take care of this using a simple parser. I have two functions, one is called NumStringParts which returns the number of "parts" in a string with a specific delimiter (in your case above the space) and GetStrPart returns the specific part from a string with a specific delimiter. Both of these routines have been used since my Turbo Pascal days in many a project.
function NumStringParts(SourceStr,Delimiter:String):Integer;
var
offset : integer;
curnum : integer;
begin
curnum := 1;
offset := 1;
while (offset <> 0) do
begin
Offset := Pos(Delimiter,SourceStr);
if Offset <> 0 then
begin
Inc(CurNum);
Delete(SourceStr,1,(Offset-1)+Length(Delimiter));
end;
end;
result := CurNum;
end;
function GetStringPart(SourceStr,Delimiter:String;Num:Integer):string;
var
offset : integer;
CurNum : integer;
CurPart : String;
begin
CurNum := 1;
Offset := 1;
While (CurNum <= Num) and (Offset <> 0) do
begin
Offset := Pos(Delimiter,SourceStr);
if Offset <> 0 then
begin
CurPart := Copy(SourceStr,1,Offset-1);
Delete(SourceStr,1,(Offset-1)+Length(Delimiter));
Inc(CurNum)
end
else
CurPart := SourceStr;
end;
if CurNum >= Num then
Result := CurPart
else
Result := '';
end;
Example of usage:
var
st : string;
f1,f2 : double;
begin
st := 'a number 12.35 and another 13.415';
ShowMessage('Total String parts = '+IntToStr(NumStringParts(st,#32)));
f1 := StrToFloatDef(GetStringPart(st,#32,3),0.0);
f2 := StrToFloatDef(GetStringPart(st,#32,6),0.0);
ShowMessage('Float 1 = '+FloatToStr(F1)+' and Float 2 = '+FloatToStr(F2));
end;
These routines work wonders for simple or strict comma delimited strings too. These routines work wonderfully in Delphi 2009/2010.