Remove duplicates from combobox - delphi

Say i have a combobox with
apples
apples
pears
oranges
oranges
i would like to have it show
apples
pears
oranges
how can i do this?

for iter := combobox.Items.Count - 1 downto 0 do
begin
index := combobox.Items.IndexOf(combobox.Items[iter]);
if index < iter then
combobox.Items.Delete(iter);
end;

I suggest that you simply refill the combo box each time. That makes the logic simpler:
ComboBox.Items.BeginUpdate;
try
ComboBox.Clear;
for Str in Values do
begin
if ComboBox.Items.IndexOf (Str) = -1 then
ComboBox.Items.Add (Str);
end;
finally
ComboBox.Items.EndUpdate;
end;

Just to put methods against eachother: one keeps the order but is increasingly slow with larger number of items. The other stays relatively faster but doesn't keep order:
procedure SortStringlist;
var
i,index,itimer: integer;
sl : TStringlist;
const
numberofitems = 10000;
begin
sl := TStringlist.Create;
for i := 0 to numberofitems-1 do begin
sl.Add(IntToStr(random(2000)));
end;
Showmessage(IntToStr(sl.Count));
itimer := GetTickCount;
sl.Sort;
for I := sl.Count-1 downto 1 do begin
if sl[i]=sl[i-1] then sl.Delete(i);
end;
Showmessage(IntToStr(sl.Count)+' Time taken in ms: '+IntToStr(GetTickCount-itimer));
sl.free;
sl := TStringlist.Create;
for i := 0 to numberofitems-1 do begin
sl.Add(IntToStr(random(2000)));
end;
Showmessage(IntToStr(sl.Count));
itimer := GetTickCount;
for i := sl.Count - 1 downto 0 do
begin
index := sl.IndexOf(sl[i]);
if index < i then
sl.Delete(i);
end;
Showmessage(IntToStr(sl.Count)+' Time taken in ms: '+IntToStr(GetTickCount-itimer));
end;

If you don't care if the items get reordered (or they're sorted already), TStrings can do the work for you - it eliminates all of the looping, deletion, and other work. (Of course, it requires the creation/destruction of a temporary TStringList, so if that's an issue for you it won't work.)
var
SL: TStringList;
begin
ComboBox1.Items.BeginUpdate;
try
SL := TStringList.Create;
try
SL.Sorted := True; // Required for Duplicates to work
SL.Duplicates := dupIgnore;
SL.AddStrings(ComboBox1.Items);
ComboBox1.Items.Assign(SL);
finally
SL.Free;
end;
finally
ComboBox1.Items.EndUpdate;
end;
end;
To properly compare with Igor's answer (which includes no BeginUpdate/EndUpdate), remove those things:
var
SL: TStringList;
begin
SL := TStringList.Create;
try
SL.Sorted := True; // Required for Duplicates to work
SL.Duplicates := dupIgnore;
SL.AddStrings(ComboBox1.Items);
ComboBox1.Items.Assign(SL);
finally
SL.Free;
end;
end;

You have to remove duplicates from the source data.
In most scenarios, a ComboBox is filled with data in run-time, which means, data is coming from some source. There are basically 2 scenarios here: a dataset from database and a collection of strings from any other source. In both cases you filter out duplicates before inserting anything into the ComboBox.
If source is a dataset from database, simply use the SQL DISTINCT keyword.
If source is any collection of strings, use a peace of code provided in the answer by #Smasher.

I faced this problem several times before, and i used all the previous approaches and I'm still using them, but do you know : i think the best approach , though not mentioned here, is to subclass TComboBox, creating a new method (say AddUnique ) that add the string to the combo ONLY if it does not exist previously , otherwise it will drop it.
This solution may cost some extra time in the beginning , but it will solve the problem once and for all.

Related

Delphi - Check each line of a file againt another file

I have to check each line of a file against another file.
If one line from the first file exists in the second file I have to delete it.
Right now i'm using 2 listboxes and the "for listbox1.items.count-1 downto do begin..."
My program works but I have to check this for huge files with over 1 milion lines.
Is there a faster approach to this method?
I want to load the files inside memory in order to be extremely fast!
Thanks
You can use TStringList for this. List for second file should be sorted for faster search. Try this:
var
l1, l2: TStringList;
i: integer;
begin
l1 := nil;
l2 := nil;
try
l1 := TStringList.Create;
l1.loadfromFile('file1');
l2 := TStringList.Create;
l2.LoadFromFile('file2');
l2.Sorted := True;
for i := l1.Count -1 downto 0 do
begin
if l2.IndexOf(l1[i]) <> -1 then
l1.Delete(i);
end;
l1.SaveToFile('file1');
finally
FreeEndNil(l1);
FreeEndNil(l2);
end
end
A quick solution (but not the fastest one) is to use two TStringList lists instead of list boxes.
var
a, b: TStringList;
i: Integer;
begin
a := TStringList.Create;
b := TStringList.Create;
try
a.LoadFromFile('C:\1.txt');
b.LoadFromFile('C:\2.txt');
b.Sorted := True;
for i := a.Count - 1 downto 0 do
begin
// Check if line of file 'a' are present in file 'b'
// and delete line if true
if b.IndexOf(a[i]) > -1 then
a.Delete(i);
end;
a.SaveToFile('C:\1.txt');
finally
b.Free;
a.Free;
end;
end;
Again, this is a slow and simple solution that loads whole files in RAM. It still will be much faster than using a ListBox. Sometimes simple is just enough for solving a one-time problem.
A faster method would be to create an index (eg. binary tree) of both files on hard disk and use this index to compare. That way you will not need to store the whole files on disk.

Why does scrolling through ADOTable get slower and slower?

I want to read the entire table from an MS Access file and I'm trying to do it as fast as possible. When testing a big sample I found that the loop counter increases faster when it's reading the top records comparing to last records of the table. Here's a sample code that demonstrates this:
procedure TForm1.Button1Click(Sender: TObject);
const
MaxRecords = 40000;
Step = 5000;
var
I, J: Integer;
Table: TADOTable;
T: Cardinal;
Ts: TCardinalDynArray;
begin
Table := TADOTable.Create(nil);
Table.ConnectionString :=
'Provider=Microsoft.ACE.OLEDB.12.0;'+
'Data Source=BigMDB.accdb;'+
'Mode=Read|Share Deny Read|Share Deny Write;'+
'Persist Security Info=False';
Table.TableName := 'Table1';
Table.Open;
J := 0;
SetLength(Ts, MaxRecords div Step);
T := GetTickCount;
for I := 1 to MaxRecords do
begin
Table.Next;
if ((I mod Step) = 0) then
begin
T := GetTickCount - T;
Ts[J] := T;
Inc(J);
T := GetTickCount;
end;
end;
Table.Free;
// Chart1.SeriesList[0].Clear;
// for I := 0 to Length(Ts) - 1 do
// begin
// Chart1.SeriesList[0].Add(Ts[I]/1000, Format(
// 'Records: %s %d-%d %s Duration:%f s',
// [#13, I * Step, (I + 1)*Step, #13, Ts[I]/1000]));
// end;
end;
And the result on my PC:
The table has two string fields, one double and one integer. It has no primary key nor index field. Why does it happen and how can I prevent it?
I can reproduce your results using an AdoQuery with an MS Sql Server dataset of similar size to yours.
However, after doing a bit of line-profiling, I think I've found the answer to this, and it's slightly counter-intuitive. I'm sure everyone who does
DB programming in Delphi is used to the idea that looping through a dataset tends to be much quicker if you surround the loop by calls to Disable/EnableControls. But who would bother to do that if there are no db-aware controls attached to the dataset?
Well, it turns out that in your situation, even though there are no DB-aware controls, the speed increases hugely if you use Disable/EnableControls regardless.
The reason is that TCustomADODataSet.InternalGetRecord in AdoDB.Pas contains this:
if ControlsDisabled then
RecordNumber := -2 else
RecordNumber := Recordset.AbsolutePosition;
and according to my line profiler, the while not AdoQuery1.Eof do AdoQuery1.Next loop spends 98.8% of its time executing the assignment
RecordNumber := Recordset.AbsolutePosition;
! The calculation of Recordset.AbsolutePosition is hidden, of course, on the "wrong side" of the Recordset interface, but the fact that the time to call it apparently increases the further you go into the recordset makes it reasonable imo to speculate that it's calculated by counting from the start of the recordset's data.
Of course, ControlsDisabled returns true if DisableControls has been called and not undone by a call to EnableControls. So, retest with the loop surrounded by Disable/EnableControls and hopefully you'll get a similar result to mine. It looks like you were right that the slowdown isn't related to memory allocations.
Using the following code:
procedure TForm1.btnLoopClick(Sender: TObject);
var
I: Integer;
T: Integer;
Step : Integer;
begin
Memo1.Lines.BeginUpdate;
I := 0;
Step := 4000;
if cbDisableControls.Checked then
AdoQuery1.DisableControls;
T := GetTickCount;
{.$define UseRecordSet}
{$ifdef UseRecordSet}
while not AdoQuery1.Recordset.Eof do begin
AdoQuery1.Recordset.MoveNext;
Inc(I);
if I mod Step = 0 then begin
T := GetTickCount - T;
Memo1.Lines.Add(IntToStr(I) + ':' + IntToStr(T));
T := GetTickCount;
end;
end;
{$else}
while not AdoQuery1.Eof do begin
AdoQuery1.Next;
Inc(I);
if I mod Step = 0 then begin
T := GetTickCount - T;
Memo1.Lines.Add(IntToStr(I) + ':' + IntToStr(T));
T := GetTickCount;
end;
end;
{$endif}
if cbDisableControls.Checked then
AdoQuery1.EnableControls;
Memo1.Lines.EndUpdate;
end;
I get the following results (with DisableControls not called except where noted):
Using CursorLocation = clUseClient
AdoQuery.Next AdoQuery.RecordSet AdoQuery.Next
.MoveNext + DisableControls
4000:157 4000:16 4000:15
8000:453 8000:16 8000:15
12000:687 12000:0 12000:32
16000:969 16000:15 16000:31
20000:1250 20000:16 20000:31
24000:1500 24000:0 24000:16
28000:1703 28000:15 28000:31
32000:1891 32000:16 32000:31
36000:2187 36000:16 36000:16
40000:2438 40000:0 40000:15
44000:2703 44000:15 44000:31
48000:3203 48000:16 48000:32
=======================================
Using CursorLocation = clUseServer
AdoQuery.Next AdoQuery.RecordSet AdoQuery.Next
.MoveNext + DisableControls
4000:1031 4000:454 4000:563
8000:1016 8000:468 8000:562
12000:1047 12000:469 12000:500
16000:1234 16000:484 16000:532
20000:1047 20000:454 20000:546
24000:1063 24000:484 24000:547
28000:984 28000:531 28000:563
32000:906 32000:485 32000:500
36000:1016 36000:531 36000:578
40000:1000 40000:547 40000:500
44000:968 44000:406 44000:562
48000:1016 48000:375 48000:547
Calling AdoQuery1.Recordset.MoveNext calls directly into the MDac/ADO layer, of
course, whereas AdoQuery1.Next involves all the overhead of the standard TDataSet
model. As Serge Kraikov said, changing the CursorLocation certainly makes a difference and doesn't exhibit the slowdown we noticed, though obviously it's significantly slower than using clUseClient and calling DisableControls. I suppose it depends on exactly what you're trying to do whether you can take advantage of the extra speed of using clUseClient with RecordSet.MoveNext.
When you open a table, ADO dataset internally creates special data structures to navigate dataset forward/backward - "dataset CURSOR". During navigation, ADO stores the list of already visited records to provide bidirectional navigation.
Seems ADO cursor code uses quadratic-time O(n2) algorithm to store this list.
But there are workaround - use server-side cursor:
Table.CursorLocation := clUseServer;
I tested your code using this fix and get linear fetch time - fetching every next chunk of records takes the same time as previous.
PS Some other data access libraries provides special "unidirectional" datasets - this datasets can traverse only forward and don't even store already traversed records - you get constant memory consumption and linear fetch time.
DAO is native to Access and (IMHO) is typically faster.
Whether or not you switch, use the GetRows method. Both DAO and ADO support it.
There is no looping. You can dump the entire recordset into an array with a couple of lines of code. Air code:
yourrecordset.MoveLast
yourrecordset.MoveFirst
yourarray = yourrecordset.GetRows(yourrecordset.RecordCount)

What is the most elegant way to reposition after filtering a TClientDataset

I'm working on a TClientDataset that the user can filter at any time based on some criterias. My problem is, we'd like the dataset's cursor to remain positionned "mostly" at the same place after filtering. ("Mostly" in double quote since, of course, it can't stay at the same place if the record is filtered out).
After doing some research, the best I could come up with is the following :
procedure RefreshFilter;
var
I : Integer;
sFilter : string;
vIndexValue: array of TVarRec;
vIndexValueAsVar : Array of Variant;
begin
sFilter := GenerateNewFilterExpression;
if sFilter <> MyDataset.Filter then
begin
if MyDataset.IndexFieldCount > 0 then
begin
SetLength(vIndexValueAsVar, MyDataset.IndexFieldCount);
SetLength(vIndexValue, MyDataset.IndexFieldCount);
for I := 0 to MyDataset.IndexFieldCount - 1 do
begin
vIndexValueAsVar[I] := MyDataset.IndexFields[I].AsVariant;
vIndexValue[I].VType := vtVariant;
vIndexValue[I].VVariant := #vIndexValueAsVar[I];
end;
end;
MyDataset.Filtered := sFilter <> '';
Mydataset.Filter := sFilter;
if MyDataset.IndexFieldCount > 0 then
begin
MyDataset.FindNearest(vIndexValue);
end;
end;
end;
Even though it works pretty well, I find the solution a bit "bulky". I was wondering if there was a some built-in function or a different approach that might be more elegant and less "heavy".
And please, don't mention bookmarks... Bookmarks don't work properly after changing the active filter, and not at all if your record gets filtered out.

Removing duplicate from TStringList

I am parsing a dataset and assigning values to TStringList i want to avoid the duplicates. I use the following code but still duplicates are inserted.
channelList := TStringList.Create;
channelList.Duplicates := dupIgnore;
try
dataset.First;
while not dataset.EOF do
begin
channelList.Add(dataset.FieldByName('CHANNEL_INT').AsString) ;
dataset.Next;
end;
why does the duplicates added?
http://docwiki.embarcadero.com/Libraries/XE2/en/System.Classes.TStringList.Duplicates
You did read http://docwiki.embarcadero.com/Libraries/XE2/en/System.Classes.TStringList.Duplicates , didn't you ?
Then you missed the most repeated word there - "sorted"
channelList.Sorted := true
var F: TField;
channelList := TStringList.Create;
channelList.Sorted := True;
channelList.Duplicates := dupIgnore;
try
dataset.First;
F := dataset.FieldByName('CHANNEL_INT');
while not dataset.EOF do
begin
channelList.Add(F.AsString);
dataset.Next;
end;
Think out of the box and avoid the duplicates up front?
I don't know what DB you are using but for example on SQL server it is just a matter of querying:
'SELECT DISTINCT CHANNEL_INT FROM MYTABLE';
and then you can add the results to your TStringList without being worried about duplicates.

Delphi loop speed question

Is there a faster way? I basically need to add AA-ZZ to thousands of records at a time.
Just a list of 35 items takes quite a while to complete muchless a list of a thousand.
procedure Tmainform.btnSeederClick(Sender: TObject);
var
ch,ch2:char;
i:integer;
slist1, slist2:TStrings;
begin
slist1:= TStringList.Create;
slist2:= TStringList.Create;
slist1.Text :=queuebox.Items.Text;
for ch := 'a' to 'z' do
begin
for ch2 := 'a' to 'z' do
begin
//
for I := 0 to slist1.Count - 1 do
begin
application.ProcessMessages; // so it doesn't freeze the application in long loops. Not 100% sure where this should be placed, if at all.
sleep(1); //Without this it doesn't process the cancel button.
if cancel then Break;
slist2.Add(slist1.Strings[i]+ch+ch2);
end;
end;
end;
insertsingle(slist2,queuebox);
freeandnil(slist1);
freeandnil(slist2);
end;
Thanks for any help
There are a couple obvious problems with your code.
First off, you're wasting a lot of CPU cycles computing the same values over and over again. The AA..ZZ values aren't going to change, so there's no need to build them over and over. Try something like this: Create a third TStringList. Go through and fill it with all possible AA..ZZ permutations with your double loop. Once that's over with, loop through and merge this list of precomputed strings with the values in slist1. You should see a pretty big boost from that.
(Or, if time is absolutely at a premium, write a minor little program that will compute the permutation list and save it to a textfile, then compile that into your app as a string resource which you can load at runtime.)
Second, and this is probably what's killing you, you shouldn't have the ProcessMessages and the Sleep calls in the innermost loop. Sleep(1); sounds like it means "sleep for 1 milisecond", but Windows doesn't offer that sort of precision. What you end up getting is "sleep for at least 1 milisecond". It releases the CPU until Windows gets back around to it, which is usually somewhere on the order of 16 miliseconds. So you're adding a delay of 16 msec (plus as long as ProcessMessages takes) into a very tight loop that probably takes only a few microseconds to execute the rest of its code.
If you need something like that to keep the UI responsive, it should be in the outermost loop, not an inner one, and you probably don't even need to run it every iteration. Try something like if ch mod 100 = 0 then //sleep and process messages here. Craig's suggestion to move this task to a worker thread would also help, but only if you know enough about threads to get it right. They can be tricky.
You should surround your code with slist2.BeginUpdate() and slist2.EndUpdate(), to stop TStringList from doing extra processing.
From my experience, you would get a very large improvement by using fewer ProcessMessages(); Sleep(1); statements, as suggested in other answers.
Try moving it to just below the first for loop, and see what improvement you get.
An example of how you might use a secundary thread to do the heavy work.
Note that for the 35 items you mention, it is really not worth it to start another thread. For a few thousand items the game changes. Processing 10.000 items takes 10 seconds on my desktop computer.
Some benefits of multithreading:
the main thread stays responsive.
the calculation can be stopped at will.
and offcourse some pitfalls:
care must be taken (in its current implementation) to not mess with the passed stringlists while the seeding is running.
multithreading adds complexity and are source for hard to find bugs.
paste below code in our favorite editor and you should be good to go.
procedure TForm1.btnStartClick(Sender: TObject);
var
I: Integer;
begin
//***** Fill the sourcelist
FSource := TStringList.Create;
FDestination := TStringList.Create;
for I := 0 to 9999 do
FSource.Add(Format('Test%0:d', [I]));
//***** Create and fire Thread
FSeeder := TSeeder.Create(FSource, FDestination);
FSeeder.OnTerminate := DoSeederDone;
FSeeder.Resume;
end;
procedure TForm1.btnStopClick(Sender: TObject);
begin
if Assigned(FSeeder) then
FSeeder.Terminate;
end;
procedure TForm1.DoSeederDone(Sender: TObject);
var
I, step: Integer;
begin
I := 0;
step := 0;
while I < FDestination.Count do
begin
//***** Don't show every item. OutputDebugString is pretty slow.
OutputDebugString(PChar(FDestination[I]));
Inc(step);
Inc(I, step);
end;
FSource.Free;
FDestination.Free;
end;
{ TSeeder }
constructor TSeeder.Create(const source, destination: TStringList);
begin
//***** Create a suspended, automatically freed Thread object.
Assert(Assigned(source));
Assert(Assigned(destination));
Assert(destination.Count = 0);
inherited Create(True);
FreeOnTerminate := True; //***** Triggers the OnTerminate event
FSource := source;
FDestination := destination;
end;
procedure TSeeder.Execute;
var
I, J: Integer;
AString: string;
begin
FDestination.BeginUpdate;
try
FDestination.Capacity := FSource.Count * 26 * 26;
for I := 0 to Pred(FSource.Count) do
begin
AString := FSource[I];
for J := 0 to Pred(26 * 26) do
begin
FDestination.Add(AString + Char(J div 26 + $41) + Char(J mod 26 + $41));
if Terminated then Exit;
end;
end;
finally
FDestination.EndUpdate;
end;
end;
OK. I have tried to optimize your code. For final tests, some test-data is needed.
What I have done (it include most of the ideas from Mason):
comment out the code about "cancel" and "
gave types and variables a more meaningfull name
used the names that Delphi uses ("Application" in stead of "application", etc) to make it readable
moved some logic into "KeepUIGoing"
move the calculation of the suffixes out of the main loop into an initialization loop
made it optionally use a TStringBuilder (which can be way faster than a TStringList, and is available since Delphi 2009)
Below is the modified code, let me know if it works for you.
procedure TForm2.Button1Click(Sender: TObject);
{$define UseStringBuilder}
procedure KeepUIGoing(SourceListIndex: Integer);
begin
if SourceListIndex mod 100 = 0 then
begin
Application.ProcessMessages;
// so it doesn't freeze the application in long loops. Not 100% sure where this should be placed, if at all.
Sleep(1);
end;
end;
const
First = 'a';
Last = 'z';
type
TRange = First .. Last;
TSuffixes = array [TRange, TRange] of string;
var
OuterIndex, InnerIndex: Char;
SourceListIndex: Integer;
SourceList, TargetList: TStrings;
Suffixes: TSuffixes;
NewLine: string;
{$ifdef UseStringBuilder}
TargetStringBuilder: TStringBuilder; // could be way faster than TStringList
{$endif UseStringBuilder}
begin
for OuterIndex := First to Last do
for InnerIndex := First to Last do
Suffixes[OuterIndex, InnerIndex] := OuterIndex + InnerIndex;
SourceList := TStringList.Create;
TargetList := TStringList.Create;
{$ifdef UseStringBuilder}
TargetStringBuilder := TStringBuilder.Create();
{$endif UseStringBuilder}
try
SourceList.Text := queuebox.Items.Text;
for OuterIndex := First to Last do
begin
for InnerIndex := First to Last do
begin
for SourceListIndex := 0 to SourceList.Count - 1 do
begin
KeepUIGoing(SourceListIndex);
// if cancel then
// Break;
NewLine := SourceList.Strings[SourceListIndex] + Suffixes[OuterIndex, InnerIndex];
{$ifdef UseStringBuilder}
TargetStringBuilder.AppendLine(NewLine);
{$else}
TargetList.Add(NewLine);
{$endif UseStringBuilder}
end;
end;
end;
{$ifdef UseStringBuilder}
TargetList.Text := TargetStringBuilder.ToString();
{$endif UseStringBuilder}
// insertsingle(TargetList, queuebox);
finally
{$ifdef UseStringBuilder}
FreeAndNil(TargetStringBuilder);
{$endif UseStringBuilder}
FreeAndNil(SourceList);
FreeAndNil(TargetList);
end;
end;
--jeroen
I would see if you can do it in one loop as per comment. Also try doing it in a thread so you can eliminate the Application.ProcessMessages and Sleep calls without blocking the UI.
I know this doesn't specifically answer your question, but if you are interested in Delphi algorithm's, Julian Bucknall (CTO of DevExpress) wrote the definitive Delphi algorithms book
Tomes of Delphi: Algorithms and Data Structures:
Chapter 1: What is an algorithm?
Chapter 2: Arrays
Chapter 3: Linked Lists, Stacks, and Queues
Chapter 4: Searching
Chapter 5: Sorting
Chapter 6: Randomized Algorithms
Chapter 7: Hashing and Hash Tables
Chapter 8: Binary Trees
Chapter 9: Priority Queues and Heapsort
Chapter 10: State Machines and Regular Expressions
Chapter 11: Data Compression
Chapter 12: Advanced Topics
You can also get his EZDSL (Easy Data Structures Library) for Delphi 2009 and Delphi 6-2007.
try this sample code - hope this will help a little (Delphi 5 Ent./WinXP)
procedure TForm1.Button1Click(Sender: TObject);
var
i,k: Integer;
sourceList, destList: TStringList;
ch1, ch2: char;
begin
destList := TStringList.Create;
sourceList := TStringList.Create;
//some sample data but I guess your list will have 1000+
//entries?
sourceList.Add('Element1');
sourceList.Add('Element2');
sourceList.Add('Element3');
try
i := 0;
while i < (26*26) do
begin
if (i mod 100) = 0 then
Application.ProcessMessages;
ch1 := char(65 + (i div 26));
ch2 := char(65 + (i mod 26));
for k := 0 to sourceList.Count -1 do
destList.Add(Format('%s-%s%s', [sourceList.Strings[k], ch1, ch2]));
Inc(i);
end;
Memo1.Lines.AddStrings(destList);
finally
FreeAndNil(destList);
FreeAndNil(sourceList);
end;
end;
--Reinhard
If you want events to be processed during your loop, such as the Cancel button being clicked, calling Application.ProcessMessages is sufficient. If you call that regularly but not too regularly, e.g. 50 times per second, then your application will remain responsive to the Cancel button without slowing down too much. Application.ProcessMessages returns pretty quickly if there aren't any messages to be processed.
This technique is appropriate for relatively short computations (a few seconds) that you would expect the user to wait on. For long computations a background thread is more appropriate. Then your application can remain fully responsive, particularly if the user has a multi-core CPU.
Calling Sleep in the main thread does not allow your application to process events. It allows other applications to do something. Calling Sleep really puts your application (the calling thread, actually) to sleep for the requested amount of time or the remainder of the thread's time slice, whichever is larger.
Use Delphi backgroundworker Component for this purpose can be better than thread.it is a easy and event based.features of backgroundworker(additional use Thread) :
Use Event based code. no need create class
Add Progress to process
Sample Code:
procedure TForm2.FormCreate(Sender: TObject);
var
I: Integer;
begin
FSource := TStringList.Create;
FDestination := TStringList.Create;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
I: Integer;
begin
try
FSource.BeginUpdate;
FSource.Clear;
for I := 0 to 9999 do
FSource.Add(Format('Test%0:d', [I]));
BackgroundWorker1.Execute;
finally
FSource.EndUpdate;
end;
end;
procedure TForm2.StopButtonClick(Sender: TObject);
begin
BackgroundWorker1.Cancel;
end;
procedure TForm2.FormDestroy(Sender: TObject);
begin
FreeAndNil(FSource);
FreeAndNil(FDestination);
end;
procedure TForm2.BackgroundWorker1Work(Worker: TBackgroundWorker);
var
I, J: Integer;
AString: string;
begin
FDestination.BeginUpdate;
try
FDestination.Capacity := FSource.Count * 26 * 26;
for I := 0 to Pred(FSource.Count) do
begin
AString := FSource[I];
for J := 0 to Pred(26 * 26) do
begin
FDestination.Add(AString + Char(J div 26 + $41) + Char(J mod 26 + $41));
if Worker.CancellationPending then
Exit;
end;
if I mod 10 = 0 then
TThread.Sleep(1);
Worker.ReportProgress((I * 100) div FSource.Count);
end;
Worker.ReportProgress(100); // completed
finally
FDestination.EndUpdate;
end;
end;
procedure TForm2.BackgroundWorker1WorkProgress(Worker: TBackgroundWorker;
PercentDone: Integer);
begin
ProgressBar1.Position := PercentDone;
end;
if you are looking for pure speed just unroll the code into a single loop and write each line as a separate assignment. You could write a program to write the lines for you automatically then copy and past them into your code. This would essentially be about the fastest method possible. Also turn off all updates as mentioned above.
procedure Tmainform.btnSeederClick(Sender: TObject);
var
ch,ch2:char;
i:integer;
slist1, slist2:TStrings;
begin
slist1:= TStringList.Create;
slist2:= TStringList.Create;
slist1.Text :=queuebox.Items.Text;
slist2.BeginUpdate()
for I := 0 to slist1.Count - 1 do
begin
application.ProcessMessages; // so it doesn't freeze the application in long loops. Not 100% sure where this should be placed, if at all.
if cancel then Break;
slist2.Add(slist1.Strings[i]+'AA');
slist2.Add(slist1.Strings[i]+'AB');
slist2.Add(slist1.Strings[i]+'AC');
...
slist2.Add(slist1.Strings[i]+'ZZ');
end;
slist2.EndUpdate()
insertsingle(slist2,queuebox);
freeandnil(slist1);
freeandnil(slist2);
end;

Resources