How to make edit control not accept 0 as first digit? - delphi

Well, I have an edit that takes only numbers (no letters, no symbols, only numbers). The problem is that i don't want the user to put 0 as the first digit, for example (0239847).
I was thinking of making a variable "x" --> byte which will count the lenght of the edit and delete the first digit, if it is 0:
var l:length; number:string100;
begin
l:length(edit1.text);
Now if the first digit is 0 (0239847), then delete it, BUT if there are not other numbers (only 0), leave it as it is.
Omg, i finally found the easiest way to do this:
procedure TForm1.Edit1Change(Sender: TObject);
var digit1:string;
begin
digit1:=edit1.Text;
if (digit1='00') or (digit1='01') or (digit1='02') or (digit1='03') or (digit1='04') or
(digit1='05') or (digit1='06') or (digit1='07') or (digit1='08') or (digit1='09') then
edit1.Text:=clear; //or edit1.text:=0; it's the same
end;
end.
The can still copy and paste numbers, but i don't mind
It was a pretty silly question, because the answer was easy and obvious, but if you are way too tired, it is hard to find it, i am sorry for getting you busy for this, Andreas, thanks for your help and tips.

It is hard to do this well. The most ambitious approach would be to do a lot of logic on key down, paste, etc., like in this answer. You'd be surprised how many cases there are to handle!
This works pretty well, I think:
type
TEdit = class(StdCtrls.TEdit)
...
procedure TEdit.KeyPress(var Key: Char);
function InvalidKey: boolean;
begin
InvalidKey :=
(
(Key = '0') and
(
((SelStart = 0) and (Length(Text) - SelLength <> 0))
or
((SelStart = 1) and (Text[1] = '0'))
)
)
or
(
not (Key in ['0'..'9', #8, ^Z, ^X, ^C, ^V])
)
end;
begin
inherited;
if InvalidKey then
begin
beep;
Key := #0;
end else if (SelStart = 1) and (Text[1] = '0') then
begin
Text := Copy(Text, 2);
end;
end;
procedure TEdit.WMPaste(var Message: TWMPaste);
var
ClipbrdText: string;
function ValidText: boolean;
var
i: Integer;
begin
result := true;
for i := 1 to Length(ClipbrdText) do
if not (ClipbrdText[i] in ['0'..'9']) then
begin
result := false;
break;
end;
end;
function RemoveLeadingZeros(const S: string): string;
var
NumLeadingZeros: integer;
i: Integer;
begin
NumLeadingZeros := 0;
for i := 1 to Length(S) do
if S[i] = '0' then
inc(NumLeadingZeros)
else
break;
result := Copy(S, NumLeadingZeros + 1);
end;
begin
if Clipboard.HasFormat(CF_TEXT) then
begin
ClipbrdText := Clipboard.AsText;
if not ValidText then
begin
beep;
Exit;
end;
if SelStart = 0 then
ClipbrdText := RemoveLeadingZeros(ClipbrdText);
SelText := ClipbrdText;
end
else
inherited;
end;
This looks complicated, but all this logic is necessary. For instance, the code handles all these cases well:
You can only enter digits.
If SelStart = 0 and not every character is selected, you cannot enter 0, because then you would get a leading zero.
If SelStart = 0 and every character is selected, you can enter 0. Because you should be able to enter this valid number.
A special case: If there are zero characters, then of course zero characters are selected, so by simply logic you will be able to enter 0 from the state of the empty string!
If SelStart = 1 and the Text[1] = '0' [if SelStart = 1, then Text[1] exists, so we rely on boolean short-circuit evaluation here], then you cannot enter 0.
If the contents of the edit field is 0 and you add a non-zero character after the zero, then the zero is removed (and there is no interference with the caret position).
You can only paste digits. If SelStart = 0, leading zeros (in the clipboard data) are discarded.
In fact, to make the behaviour perfect, you need even more code. For instance, suppose that the contents of the edit field is 123000456. As it is now, you can select the first three characters (123) and press Backspace or Delete to obtain the invalid text 000456. The solution is to add extra code that removes leading zeroes resulting from either of these two operations. Update: I have been doing some thinking, and have come to realise that it is probably best not to implement this (why?).
One shortcut, however, would be to 'prettify' the contents of the edit when it isn't focused, because when it isn't, you are much less likely to shoot the user in the foot by doing something with the contents of the edit.
For instance, you can do something like
function PrettifyNumber(const S: string): string;
var
NumLeadingZeros: integer;
i: Integer;
begin
NumLeadingZeros := 0;
for i := 1 to Length(S) do
if S[i] = '0' then
inc(NumLeadingZeros)
else
break;
result := Copy(S, NumLeadingZeros + 1);
if length(result) = 0 then
result := S;
end;
and then replace the contents of the edit field by its prettified version when it loses keyboard focus. Of course, you should consider adding this functionality to a derived edit class, but for testing you can simply use the OnExit event:
procedure TForm1.Edit1Exit(Sender: TObject);
begin
Edit1.Text := PrettifyNumber(Edit1.Text);
end;
I suppose that you want this functionality in a lot of edits in a major application (or not so major). So you will in fact write your own subclassed control. Then I suppose you will also need other types of verification than simply removal of leading zeros? You thus have to integrate this code nicely with the rest of the code. If in fact you will use this edit 'subclass' everywhere in a big application, you could also consider adding a shortcut, to the edit control class, so that you can prettify/verify the text on demand, and not only on exit (which is particularly difficult if the edit control is alone on its form!)
Update
On request, this is a simple solution that works badly:
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if (Key = '0') and (Edit1.SelStart = 0) then Key := #0;
end;
I leave it as an exercise to figure out the issues with this approach. If you fix the issues, one by one, as you discover them, you will end up with my long code above!

You could use TmaskEdit. This force the user to input the numbers. After add eventchange for delete first digit if 0.
Example.dfm
.
.
object MaskEdit1: TMaskEdit
Left = 352
Top = 8
Width = 120
Height = 21
EditMask = '0999999;0;_'
MaxLength = 7
TabOrder = 3
OnChange = MaskEdit1Change
end
.
.
Example.pas
.
.
Procedure TForm1.MaskEdit1Change(Sender: TObject);
Begin
If Length(TMaskEdit(Sender).Text) > 1 Then
TMaskEdit(Sender).Text := IntToStr(StrToInt(TMaskEdit(Sender).Text));
End;
.
.

Related

How to extract the first instance of unique strings

I need to extract a list of unique items from 12 years' worth of consistent computer-generated one-per day text files. The filenames vary only by the included date, so it is easy to generate the required name in code. They consist of a list of all the aircraft movements at my local airport during the given day, in time order. Naturally, the same aircraft come and go many times, and the objective is to loop through the files, pick out the first instance of when each individual aircraft appears (the first visit or FV) copy it to a list and then ignore it from then on. The result should be a list of all the first visits in date order. Should be simple, but... My program is small so I am including the entire implementation code.
procedure TForm1.FormCreate(Sender: TObject);
begin
FileDate := StrToDate('01/01/2007');
FName := 'E:LGW Reports/SBSLGW2007-01-01.txt'; //1st file to be read
FDStr := copy(FName, 21, 10);
TempList := TStringList.Create; //temp holder for file contents
FVCheckList := TStringList.Create; //holds unique identifier (UID)
FVCheckList.Sorted := TRUE;
FVCheckList.Duplicates := dupIgnore;
FVList:= TStringList.Create; //the main output
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
begin
Memo1.Lines.Append('Started');
Repeat
TempList.Clear;
TempList.LoadFromFile(FName);
for i := 1 to TempList.Count-1 do
begin
Line := TempList.Strings[i];
//create a //create a Unique identifier (UID) from elements in Line
Serial := Trim(Copy(Line, 22, 9));
MsnPos1 := Pos('[', Line) + 1;
MsnPos2 := Pos(']', Line);
Msn := copy(Line, MsnPos1, (MsnPos2 - MsnPos1));
UID := Serial + '/' + Msn;
//
if (FVCheckList.IndexOf(UID) < 0) then
begin
FVCheckList.Append(UID);
//Add date of file to Line, otherwise it gives no clue when FV was
FVList.Append(FormatDateTime('YYYY-MM-DD', FileDate) + ' ' + Line);
FileDate := IncDay(FileDate, 1);
FName := 'E:LGW Reports/SBSLGW' + FormatDateTime('YYYY-MM-DD', FileDate) + '.txt';
end;
end;
Until FileExists(FName) = FALSE;
FVCheckList.SaveToFile('E:LGW Reports/First Visit Checklist.txt');
FVList.SaveToFile('E:LGW Reports/First Visits.txt');
Memo1.Lines.Append('Finished');
Memo1.Lines.SaveToFile('E:LGW Reports/Files parsed.txt');
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
TempList.Free;
FVCheckList.Free;
FVList.Free;
end;
There are no compiler errors, it runs to completion in seconds and produces the two text files specified, correctly formatted. The big problem is that the lines actually listed in FVList are not always the very first visit of the aircraft, they can be the first, the most recent or somewhere in between. I cannot see any obvious clue as to why the wrong instance is appearing: if my code is right, then something is wrong with the functioning of TStringList FVCheckList. The fault is far more likely to be something I have overlooked, or my understanding of how .dupIgnore works, or maybe my looping isn't working as it should.
I should be very grateful for any practical help. Many thanks in advance.
Repeat
...
Until FileExists(FName) = FALSE;
Should be
While FileExists(FName) = TRUE do
Begin
End;
If the first 2007-01-01 file does not exist, your code will crash on the first LoadFromFile() since you don't check for the file's existence before loading it, unlike with the subsequent files.
Otherwise, I would suggest sticking with repeat but assign FName at the top of each loop iteration instead of initializing it outside the loop and then reassigning at the bottom of each iteration. No need to duplicate efforts.
If you check IndexOf() manually, you don't need to use Sorted or dupIgnore at all. This is what you should be doing in this situation. When dupIgnore ignores a new string, Append() doesn't tell you that the string was ignored. To do that, you would have to check whether the Count was actually increased or not.
Inside the outer loop, the reassignment of FileDate and FName should be outside of the inner for loop,not inside the for loop at all.
Try this instead:
procedure TForm1.FormCreate(Sender: TObject);
begin
FileDate := EncodeDate(2007,1,1);
FDStr := FormatDateTime('YYYY-MM-DD', FileDate);
TempList := TStringList.Create; //temp holder for file contents
FVCheckList := TStringList.Create; //holds unique identifier (UID)
FVList := TStringList.Create; //the main output
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
begin
Memo1.Lines.Append('Started');
Repeat
FName := 'E:LGW Reports/SBSLGW' + FormatDateTime('YYYY-MM-DD', FileDate) + '.txt';
if not FileExists(FName) then Break;
Memo1.Lines.Append(FName)
TempList.LoadFromFile(FName);
for i := 1 to TempList.Count-1 do
begin
Line := TempList.Strings[i];
//create a Unique identifier (UID) from elements in Line
Serial := Trim(Copy(Line, 22, 9));
MsnPos1 := Pos('[', Line) + 1;
MsnPos2 := PosEx(']', Line, MsnPos1);
Msn := copy(Line, MsnPos1, (MsnPos2 - MsnPos1));
UID := Serial + '/' + Msn;
if FVCheckList.IndexOf(UID) = -1 then
begin
FVCheckList.Append(UID);
//Add date of file to Line, otherwise it gives no clue when FV was
FVList.Append(FormatDateTime('YYYY-MM-DD', FileDate) + ' ' + Line);
end;
end;
FileDate := IncDay(FileDate, 1);
end;
FVCheckList.SaveToFile('E:LGW Reports/First Visit Checklist.txt');
FVList.SaveToFile('E:LGW Reports/First Visits.txt');
Memo1.Lines.Append('Finished');
Memo1.Lines.SaveToFile('E:LGW Reports/Files parsed.txt');
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
TempList.Free;
FVCheckList.Free;
FVList.Free;
end;

Writing all instances of strings between two other strings to logfile

After looking at Delphi extract string between to 2 tags and trying the code given there by Andreas Rejbrand I realized that I needed a version that wouldn't stop after one tag - my goal is to write all the values that occur between two strings in several .xml files to a logfile.
<screen> xyz </screen> blah blah <screen> abc </screen>
-> giving a logfile with
xyz
abc
... and so on.
What I tried was to delete a portion of the text read by the function, so that when the function repeated, it would go to the next instance of the desired string and then write that to the logfile too until there were no matches left - the boolean function would be true and the function could stop - below the slightly modified function as based on the version in the link.
function ExtractText(const Tag, Text: string): string;
var
StartPos1, StartPos2, EndPos: integer;
i: Integer;
mytext : string;
bFinished : bool;
begin
bFinished := false;
mytext := text;
result := '';
while not bFinished do
begin
StartPos1 := Pos('<' + Tag, mytext);
if StartPos1 = 0 then bFinished := true;
EndPos := Pos('</' + Tag + '>', mytext);
StartPos2 := 0;
for i := StartPos1 + length(Tag) + 1 to EndPos do
if mytext[i] = '>' then
begin
StartPos2 := i + 1;
break;
end;
if (StartPos2 > 0) and (EndPos > StartPos2) then
begin
result := result + Copy(mytext, StartPos2, EndPos - StartPos2);
delete (mytext, StartPos1, 1);
end
So I create the form and assign a logfile.
procedure TTagtextextract0r.FormCreate(Sender: TObject);
begin
Edit2.Text:=(TDirectory.GetCurrentDirectory);
AssignFile(LogFile, 'Wordlist.txt');
ReWrite(LogFile);
CloseFile(Logfile);
end;
To then get the files in question, I click a button which then reads them.
procedure TTagtextextract0r.Button3Click(Sender: TObject);
begin
try
sD := TDirectory.GetCurrentDirectory;
Files:= TDirectory.GetFiles(sD, '*.xml');
except
exit
end;
j:=Length(Files);
for k := 0 to j-1 do
begin
Listbox2.Items.Add(Files[k]);
sA:= TFile.ReadAllText(Files[k]);
iL:= Length(sA);
AssignFile(LogFile, 'Wordlist.txt');
Append(LogFile);
WriteLn(LogFile, (ExtractText('screen', sA)));
CloseFile (LogFile);
end;
end;
end.
My problem is that without the boolean loop in the function, the application only writes the one line per file and then stops but with the boolean code the application gets stuck in an infinite loop - but I can't quite see where the loop doesn't end. Is it perhaps that the "WriteLn" command can't then output the result of the function? If it can't, I don't know how to get a new line for every run of the function - what am I doing wrong here?
First you need to get a grip on debugging
Look at this post for a briefing on how to pause and debug a program gone wild.
Also read Setting and modifying breakpoints to learn how to use breakpoints. If you would have stepped through your code, you would soon have seen where you go wrong.
Then to your problem:
In older Delphi versions (up to Delphi XE2) you could use the PosEx() function (as suggested in comments), which would simplify the code in ExtractText() function significantly. From Delphi XE3 the System.Pos() function has been expanded with the same functionality as PosEx(), that is, a third parameter Offset: integer
Since you are on Delphi 10 Seattle you can use interchangeably either System.StrUtils.PosEx() or System.Pos().
System.StrUtils.PosEx
PosEx() returns the index of SubStr in S, beginning the search at
Offset
function PosEx(const SubStr, S: string; Offset: Integer = 1): Integer; inline; overload;
The implementation of ExtractText() could look like this (with PosEx()):
function ExtractText(const tag, text: string): string;
var
startPos, endPos: integer;
begin
result := '';
startPos := 1;
repeat
startPos := PosEx('<'+tag, text, startpos);
if startPos = 0 then exit;
startPos := PosEx('>', text, startPos)+1;
if startPos = 1 then exit;
endPos := PosEx('</'+tag+'>', text, startPos);
if endPos = 0 then exit;
result := result + Copy(text, startPos, endPos - startPos) + sLineBreak;
until false;
end;
I added sLineBreak (in unit System.Types) after each found text, otherwise it should work as you intended it (I believe).

How to delete a specific line from a text file in Delphi

I have a text file with user information stored in it line by line. Each line is in the format: UserID#UserEmail#UserPassword with '#' being the delimiter.
I have tried to use this coding to perform the task:
var sl:TStringList;
begin
sl:=TStringList.Create;
sl.LoadFromFile('filename');
sl.Delete(Index);
sl.SaveToFile('filename');
sl.free;
end;
But I'm not sure what to put in the "index" space.
Is there any way I can receive the User ID as input and then delete the line of text from the text file that has this user ID in? Any help would be appreciated.
You can set the NameValueSeparator to # then use IndexOfName to find the user, as long as the username is the first value in the file.
sl.NameValueSeparator := '#';
Index := sl.IndexOfName('455115')
So in your example, like so
var sl:TStringList;
begin
sl:=TStringList.Create;
sl.LoadFromFile('filename');
sl.NameValueSeparator := '#';
Index := sl.IndexOfName('455115')
if (Index <> -1) then
begin
sl.Delete(Index);
sl.SaveToFile('filename');
end;
sl.free;
end;
This may be slow on large files as IndexOfName loops though each line in the TStringList and checks each string in turn until it finds a match.
Disclaimer: Tested/ works with Delphi 2007, Delphi 7 may be diffrent.
I don't see why so many people make this so hard. It is quite simple:
function ShouldDeleteLine(const UserID, Line: string): Boolean;
begin
// Remember: Pos(Needle, Haystack)
Result := Pos(UserID + '#', Line) = 1; // always 1-based!
end;
procedure DeleteLinesWithUserID(const FileName, UserID: string);
var
SL: TStringList;
I: Integer;
begin
if not FileExists(FileName) then
Exit;
SL := TStringList.Create;
try
SL.LoadFromFile(FileName); // Add exception handling for the
// case the file does not load properly.
// Always work backward when deleting items, otherwise your index
// may be off if you really delete.
for I := SL.Count - 1 downto 0 do
if ShouldDeleteLine(SL[I], UserID) then
begin
SL.Delete(I);
// if UserID is unique, you can uncomment the following line.
// Break;
end;
SL.SaveToFile(FileName);
finally
SL.Free;
end;
end;
As Arioch'The says, if you save to the same file name, you risk losing your data when the save fails, so you can do something like
SL.SaveToFile(FileName + '.dup');
if FileExists(FileName + '.old') then
DeleteFile(FileName + '.old');
RenameFile(FileName, FileName + '.old');
RenameFile(FileName + '.dup', FileName);
That keeps a backup of the original file as FileName + '.old'.
Explanations
Working backward
Why work backward? Because if you have the following items
A B C D E F G
^
And you delete the item at ^, then the following items will shift downward:
A B C E F G
^
If you iterate forward, you will now point to
A B C E F G
^
and E is never examined. If you go backward, then you will point to:
A B C E F G
^
Note that E, F and G were examined already, so now you will indeed examine the next item, C, and you won't miss any. Also, if you go upward using 0 to Count - 1, and delete, Count will become one less and at the end, you will try to access past the boundary of the list. This can't happen if you work backwards using Count - 1 downto 0.
Using + '#'
If you append '#' and test for Pos() = 1, you will be sure to catch the entire UserID up to the delimiter, and not a line with a user ID that only contains the UserID you are looking for. IOW, if UserID is 'velthuis', you don't want to delete lines like 'rudyvelthuis#rvelthuis01#password' or 'velthuisresidence#vr#password2', but you do want to delete 'velthuis#bla#pw3'.
E.g. when looking for a user name, you look for '#' + UserName + '#' for the same reason.
There is the only way to actually "delete a line from the text file" - that is to create a new file with changed content, to REWRITE it.
So you better just do it explicitly.
And don't you forget about protecting from errors. Your current code might just destroy the file and leak memory, if any error occurs...
var sl: TStringList;
s, prefix: string;
i: integer; okay: Boolean;
fs: TStream;
begin
prefix := 'UserName' + '#';
okay := false;
fs := nil;
sl:=TStringList.Create;
Try /// !!!!
sl.LoadFromFile('filename');
fs := TFileStream.Create( 'filename~new', fmCreate or fmShareExclusive );
for i := 0 to Prev(sl.Count) do begin
s := sl[ i ];
if AnsiStartsStr( prefix, Trim(s) ) then
continue; // skip the line - it was our haunted user
s := s + ^M^J; // add end-of-line marker for saving to file
fs.WriteBuffer( s[1], length(s)*SizeOf(s[1]) );
end;
finally
fs.Free;
sl.Free;
end;
// here - and only here - we are sure we successfully rewritten
// the fixed file and only no are able to safely delete old file
if RenameFile( 'filename' , 'filename~old') then
if RenameFile( 'filename~new' , 'filename') then begin
okay := true;
DeleteFile( 'filename~old' );
end;
if not okay then ShowMessage(' ERROR!!! ');
end;
Note 1: See if check for username should be case-sensitive or case-ignoring:
http://www.freepascal.org/docs-html/rtl/strutils/ansistartsstr.html
http://www.freepascal.org/docs-html/rtl/strutils/ansistartstext.html
Note 2: in Delphi 7 SizeOf( s[1] ) is always equal to one because string is an alias to AnsiString. But in newer Delphi version it is not. It might seems tedious and redundant - but it might save a LOT of headache in future. Even better would be to have a temporary AnsiString type variable like a := AnsiString( s + ^m^J ); fs.WriteBuffer(a[1],Length(a));
So far everyone has been suggesting the use for a For..Then Loop but can I suggest a Repeat..While.
The traditional For..Loop is a good option but could be inefficient if you have a long list of Usernames (they are usually unique). Once found and deleted the For Loop continues until the end of the list. That's ok if you have a small list but if you have 500,000 Usernames and the one you want is at position 10,000 there is no reason to continue beyond that point.
Therefore, try this.
Function DeleteUser(Const TheFile: String; Const TheUserName: String): Boolean;
Var
CurrentLine: Integer;
MyLines: TStringlist;
Found: Boolean;
Eof: Integer;
Begin
MyLines := TStringlist.Create;
MyLines.LoadFromFile(TheFile);
CurrentLine := 0;
Eof := Mylines.count - 1;
Found := false;
Repeat
If Pos(UpperCase(TheUserName), UpperCase(MyLines.Strings[CurrentLine])) = 1 Then
Begin
MyLines.Delete(CurrentLine);
Found := True;
End;
Inc(CurrentLine);
Until (Found) Or (CurrentLine = Eof); // Jump out when found or End of File
MyLines.SaveToFile(TheFile);
MyLines.Free;
result := Found;
End;
Once called the function returns True or False indicating the Username was deleted or not.
If Not DeleteUsername(TheFile,TheUsername) then
ShowMessage('User was not found, what were you thinking!');
Just for fun, here's a compact solution, which I like for its readability.
const fn = 'myfile.txt';
procedure DeleteUser(id: integer);
var s:string; a:TStringDynArray;
begin
for s in TFile.ReadAllLines(fn) do
if not s.StartsWith(id.ToString + '#') then
a := a + [s];
TFile.WriteAllLines(fn, a);
end;
Obviously it's not the most efficient solution. This could run faster by not appending single items to the array, or by caching the search string.
And to search for other fields, you could use s.split(['#'])[0] to find the username, s.split(['#'])[1] for email, etc.
For those who like one-liners. This works too:
const fn = 'users.txt';
procedure DeleteUserRegExp(id: string);
begin
TFile.WriteAllText(fn,TRegEx.Replace(TFile.ReadAllText(fn),''+id+'\#.*\r\n',''))
end;
Explanation
It loads the content of a file into a string.
The string is sent to TRegEx.Replace
The regular expression searches for the username followed by the hash sign, then any character, and then a CRLF. It replaces it with an empty string.
The resulting string is then written to the original file
This is just for fun though, because I saw long code where I thought that this would be possible with a single line of code.

How can limit the number of lines and characters by line in a TMemo component

I Need limit the number of lines and characters by line in a TMemo component.
example a i like to do something like this :
Memo1.MaxLines:=20;
Memo1.CharsByLine:=80;
how i can do this in delphi?
There's some undelrying problems...like what would happen if you assign the memo1.lines.text value with a large block of text? Would you want errors to occur, the data to be forced down to 80 chars/line...
It sounds like you need a word processor control instead of a TMemo. Check out http://www.TRichView.com or http://www.wpcubed.com/
I don't believe there's an easy way to do this, I have set a OnKeyPress Event before that attempts to limit it (I don't know if it handles pasting in text)
procedure AddressMemoOnKeyPressEvent(Sender: TObject; var Key: Char);
var
i, lineCount: Integer;
begin
with Sender as TMemo do
begin
if (Key <> #13) and (Key <> #8) and (Length(Lines[CaretPos.Y]) >= MAX_CHARS_PER_LINE_IN_MEMO) then
Key := #0;
lineCount := 0;
for i := 1 to Length(TMemo(Sender).Lines.Text) do
begin
if (TMemo(Sender).Lines.Text[i] = #13) then
Inc(lineCount);
end;
if (Key = #13) AND (Key <> #8) AND (lineCount >= MAX_LINES_PER_MEMO - 1) then
Key := #0;
// if we got past the last line, no key can be entered...
if (CaretPos.Y >= MAX_LINES_PER_MEMO) then
Key := #0;
end;
end;

Delphi Sorting TListView Question

I'm using the code from: http://www.swissdelphicenter.ch/torry/showcode.php?id=1103
to sort my TListView, which works GREAT on everything but numbers with decimals.
So I tried to do this myself, and I created a new Custom Sort called: cssFloat
Created a new function
function CompareFloat(AInt1, AInt2: extended): Integer;
begin
if AInt1 > AInt2 then Result := 1
else
if AInt1 = AInt2 then Result := 0
else
Result := -1;
end;
Added of the case statement telling it what type the column is..
cssFloat : begin
Result := CompareFloat(i2, i1);
end;
And I changed the Column click event to have the right type selected for the column.
case column.Index of
0: LvSortStyle := cssNumeric;
1: LvSortStyle := cssFloat;
2: LvSortStyle := cssAlphaNum;
else LvSortStyle := cssNumeric;
And The ListView Sort type is currently set to stBoth.
It doesn't sort correctly. And Ideas on how to fix this?
Thank you
-Brad
I fixed it... after 3 hours of struggling with this.. not understanding why.. I finally saw the light.. CompareFloat was asking if two integers were greater or less than each other.
cssFloat : begin
r1 := IsValidFloat(s1, e1);
r2 := IsValidFloat(s2, e2);
Result := ord(r1 or r2);
if Result <> 0 then
Result := CompareFloat(e2, e1);
end;
(Copied and modified from EFG's Delphi site)
FUNCTION isValidFloat(CONST s: STRING; var e:extended): BOOLEAN;
BEGIN
RESULT := TRUE;
TRY
e:= StrToFloat(s)
EXCEPT
ON EConvertError DO begin e:=0; RESULT := FALSE; end;
END
END {isValidFloat};
While I don't know what is the problem which you faced perhaps is useful for you...
function CompareFloat(AStr1, AStr2: string): Integer;
const
_MAGIC = -1; //or ANY number IMPOSSIBLE to reach
var
nInt1, nInt2: extended;
begin
nInt1:=StrToFloatDef(AStr1, _MAGIC);
nInt2:=StrToFloatDef(AStr2, _MAGIC);
if nInt1 > nInt2 then Result := 1
else
if nInt1 = nInt2 then Result := 0
else
Result := -1;
end;
..and another snippet (perhaps much better):
function CompareFloat(aInt1, aInt2: extended): integer;
begin
Result:=CompareValue(aInt1, aInt2); // :-) (see the Math unit) - also you can add a tolerance here (see the 'Epsilon' parameter)
end;
Besides the rounding which can cause you problems you can see what the format settings are in conversion between string and numbers (you know, the Decimal Point, Thousands Separator aso.) - see TFormatSettings structure in StringToFloat functions. (There are two - overloaded).
HTH,

Resources