I populate ScrollBoxin the alike way:
procedure TForm1.FormCreate(Sender: TObject);
var
i: word;
begin
for i := 1 to 3 do
begin
with TLabel.Create(ScrollBox1) do
begin
Parent := ScrollBox1;
Top := 1000;
AutoSize := False;
Align := alTop;
Height := 25;
Caption := 'Label' + IntToStr(i);
end;
end;
ScrollBox1.Realign;
end;
When the code is run under Delphi I get the follwong result:
The order of items is proper.
But when I call the same code under Lazarus I get:
The order of items is reverse. I can solve the issue by reverse creation of ScrollBox children and/or adding {IFDEF ...} but I suspect this is not reliable. Adding compiler switches will double the volume of code making it bulky and difficult to read.
Is there a way to do unified reliable Delphi-Lazarus code for this purpose?
APPENDED
explanation on comment of #TomBrunberg
If I create chidren in reverse order (for instance for i := 3 downto 1) I get the opposite result: Delphi produces reverse and Lazarus - direct order. That is why I was saying about doubling of code.
APPENDED 2
on note of Tom Brunberg
When the same code is called from a Button onClick event handler the code behaviour becomes opposite (and again different in Lazarus and in Delphi).
APPENDED 3
Can I trust for i := 1 to 3... Top := 1000 + i; as it gives the expected result?
I have this string where I need to make some characters capital so I use that UpCase command... But what if I need to make small character from capital one? What do I use in that case?
UpCase is not locale aware and only handles the 26 letters of the English language. If that is really all you need then you can create equivalent LoCase functions like this:
function LoCase(ch: AnsiChar): AnsiChar; overload;
begin
case ch of
'A'..'Z':
Result := AnsiChar(Ord(ch) + Ord('a')-Ord('A'));
else
Result := ch;
end;
end;
function LoCase(ch: WideChar): WideChar; overload;
begin
case ch of
'A'..'Z':
Result := WideChar(Ord(ch) + Ord('a')-Ord('A'));
else
Result := ch;
end;
end;
You should learn how to find the solution on your own, not how to use Google or stackoverflow :)
You have the source of the UpCase function in System.pas. Take a look at how it works. All this does is subtract 32 from the lower case characters. If you want the opposite, add 32 instead of subtracting it. The Delphi help will tell you what Dec or Inc does.
var
S: string;
I: Integer;
begin
S := 'ABCd';
for I := 1 to Length(S) do
if S[I] in ['A'..'Z'] then // if you know that input is upper case, you could skip this line
Inc(S[I], 32); // this line converts to lower case
end;
I read that using the Goto command is very bad and can mess up your code. I also read that there was a poll saying that 40% of Delphi developers will be very cross if they see the goto command and delphi together and the other 40% don't even know of the goto command, why is that?
But anyways, I was making a program that checks if you qualify for a bursary by getting the two marks and getting the avarage of those two marks. In order to get the Bursary, you need to have a 90% average or above and it will display your average in a label and if you qualify in another label. I recently also learned about the If command and now I am just busy playing around with it.
Here's my code:
procedure TForm1.btnCalcClick(Sender: TObject);
var
iMaths, iScience, iAvarage : integer;
begin
iScience := sedScience.value;
iMaths := sedMath.value;
iAvarage := round((iMaths+iScience)/2);
if iMaths = 0
then
begin
showmessage ('Sorry, please put a propper value in the Maths and Science box!');
end;
if iAvarage >= 90
then
begin
lblAvarage.caption := 'Your avarage is: ' + IntToStr (iAvarage);
lblOutput.caption := 'You qualify for an Einstein Bursary!';
end
else
begin
lblAvarage.Caption := 'Your avarage is ' + IntToStr (iAvarage);
lblOutput.caption := 'Sorry, you do not qualify for an Einstein bursary.';
end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
sedMath.value := 0;
sedScience.value := 0;
lblAvarage.caption := ' ';
lblOutput.caption := ' ';
sedMath.setfocus
end;
end.
Where I say if iMaths = 0 thats just making sure that there is a value in the SpinEdit, if there isn't, it must restart at the ButtonClick handler with a message saying Please insert a proper value. That all works fine, but it still displays the average in the labels (lblOutput and lblAvarage) which I don't want it to do!
If I use the goto command, this is how I think it should look:
procedure TForm1.btnCalcClick(Sender: TObject);
var
iMaths, iScience, iAvarage : integer;
label
lRestart;
begin
lRestart;
iScience := sedScience.value;
iMaths := sedMath.value;
iAvarage := round((iMaths+iScience)/2);
if iMaths and iScience = 0
then
begin
showmessage ('Sorry, please put a propper value in the Maths and Science box!');
goto lRestart;
end;
(BTW, I know the above code it wrong, I tried!)
I googled goto but I find things that are different to what I need.
Any help or advice on how to use the goto command would be greatly appreciated!
Your syntax is not correct for goto. It should be:
procedure TForm1.btnCalcClick(Sender: TObject);
....
label
lRestart;
begin
lRestart:
....
goto lRestart;
....
end;
But if you ever wanted to do something like this you'd surely avoid the goto by writing it thus:
repeat
// do something
until OkToContinue;
That said, your code should be:
procedure TForm1.btnCalcClick(Sender: TObject);
var
iMaths, iScience, iAverage: integer;
begin
iScience := sedScience.value;
iMaths := sedMath.value;
iAverage := round((iMaths+iScience)/2);
if (iMaths=0) or (iScience=0) then
begin
ShowMessage('Sorry, please put a propper value in the Maths and Science box!');
exit;
end;
// do the calculation
end;
There's no need for looping or goto in your event handler. You have to exit when you find an error and give the user opportunity to fix the mistake and click the button again. So it's just a complete mis-think on your part that you would need a goto.
I guess you have not yet fully grasped the concept of event driven programming. Were you to go back to the beginning instead of exiting the procedure, the user would have no opportunity to modify the values of the spin edit controls and you would show the message again and again and again. Try it and see what I mean.
Note also that I fixed a number of other errors in your code.
As for goto, I'm sure that you won't need it ever. I've only ever found goto to be useful in languages that don't support structured exceptions. Delphi does not fall into that camp.
You should not need to use goto in your programs.
Some reasons not to use it, since in most cases:
It will make your code less readable;
It can be easily converted into nested repeat .. until or while .. structures, which are usually with the same exact timing (will be compiled as assembler jmp .. opcode.
Sometimes, it may be slightly faster to put the conditional expression of the repeat .. until or while .. structures within the loop, and use break and continue and repeat .. until false or while true do ..:
function GotoEndOfJSONString(P: PUTF8Char): PUTF8Char;
begin // P^='"' at function call
inc(P);
repeat
if P^=#0 then
break else
if P^<>'\' then
if P^<>'"' then
inc(P) else
break else
inc(P,2);
until false;
result := P;
end; // P^='"' at function return
Which will be compiled with very optimized assembler:
inc eax
#s: mov dl,[eax]
test dl,dl
jz #e
cmp dl,$5c
je #2
cmp dl,$22
je #e
inc eax
jmp #s
#2: add eax,2
jmp #s
#e: ret
But this is perhaps worth it only for very low-level code, and will make it less readable. Writing such code is very close to writing directly the assembler code: you know that the break and continue will be converted into direct jmp .. assembler opcodes.
The only case when I use goto is in some well-defined conditions:
Identified low-level process of data (e.g. text handling);
Only for performance reasons;
With proper unit testing (since code is less readable);
When branching is needed in-between case .. of inner blocks, or from one loop to another;
When I want to avoid calling a sub-procedure in older versions of Delphi (e.g. Delphi 7) - but in modern Delphi, goto can be replaced by an inline local procedure.
Some example:
procedure TTextWriter.AddJSONEscape(P: Pointer; Len: PtrInt);
var c: PtrUInt;
label Esc, nxt;
begin
if P=nil then exit;
if Len=0 then
Len := MaxInt;
if B>=BEnd then
Flush;
repeat
inc(B);
// escape chars, according to http://www.ietf.org/rfc/rfc4627.txt
c := PByte(P)^;
if c>=32 then begin
if c in [ord('\'),{ord('/'),}ord('"')] then goto Esc;
B^ := AnsiChar(c);
nxt: if Len=1 then
break;
dec(Len);
inc(PByte(P));
if B<BEnd then
continue;
Flush;
end else
case c of
0: begin
dec(B); break; end;
8: begin
c := ord('b'); goto Esc; end;
9: begin
c := ord('t'); goto Esc; end;
$a: begin
c := ord('n'); goto Esc; end;
$c: begin
c := ord('f'); goto Esc; end;
$d: begin
c := ord('r');
Esc: B^ := '\';
if B>=BEnd then // inlined: avoid endless loop
Flush;
B[1] := AnsiChar(c);
inc(B);
goto nxt;
end;
else begin // characters below ' ', #7 e.g. -> // 'u0007'
B^ := '\';
AddShort('u00');
Add(HexChars[c shr 4],HexChars[c and $F]);
goto nxt;
end;
end;
until false;
end;
As a conclusion, outside the FastCode challenge in pure pascal or some low-level code, you should not see any goto any more.
Alright, so you have a TObjectList instance. You want to loop through the items in it and delete some of the objects from the list. You can't do this:
for I := 0 to ObjectList.Count - 1 do
if TMyClass(ObjectList[I]).ShouldRemove then
ObjectList.Delete(I);
...because once you delete the first object the index counter I will be all wrong and the loop won't work any more.
So here is my solution:
Again:
for I := 0 to ObjectList.Count - 1 do
if TMyClass(ObjectList[I]).ShouldRemove then
begin
ObjectList.Delete(I);
goto Again;
end;
This is the best solution I've found to this so far. If anyone has a neater solution I'd love to see it.
Try this instead:
for I := ObjectList.Count - 1 downto 0 do
if TMyClass(ObjectList[I]).ShouldRemove then
ObjectList.Delete(I);
That looks like a particularly bad use of goto, jumping out of the for loop like that. I assume it works (since you're using it), but it would give me the willies.
You can also use
I := 0;
while I < ObjectList.Count do begin
if TMyClass(ObjectList[I]).ShouldRemove then ObjectList.Delete(I)
else Inc(I);
end;
The only valid use of Goto I've seen is the one supplied in Delphi's help.
for I := 0 to something do
begin
for J := 0 to something do
begin
For K := 0 to something do
begin
if SomeCondition then
Goto NestedBreak
end;
end;
end;
NestedBreak:
Though Goto could be avoided in that exemple by moving the loop in a local function and using EXIT, for exemple. If a subfunction is not acceptable, you can still do that:
for I := 0 to something do
begin
for J := 0 to something do
begin
For K := 0 to something do
begin
if SomeCondition then
begin
GottaBreak := True
Break;
end;
end;
if GottaBreak then Break;
end;
if GottaBreak then Break;
end;
This is just sligthly less optimal.
I have yet to see a single other situation where a Goto would be the best solution.(Or any good at all).
Goto in itself is NOT bad. It's a flow control command just like EXIT, BREAK or CONTINUE. Except that those other are restricted to specific situations and are managed by the compiler correctly. (With that being said, some programmer I spoke with consider those as being as harmful as Goto, a view I don't share) Goto being unrestricted, the things you can do with it can have very negative impacts. Anyway, I think I went a bit beyond the scope of the question already. ^_^
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;