procedure TForm1.Timer1Timer(Sender: TObject);
var
i : integer;
begin
if i > StrToInt(Edit1.Text) then
Timer1.Enabled := False
else
i :=+ 1;
SendClick(645,302);
Sleep(2200);
SendClick(694,619);
Sleep(2200);
SendClick(967,638);
Sleep(2200);
SendKeys('{BKSP}{BKSP}{BKSP}{BKSP}1',False);
SendClick(917,688);
Sleep(2200);
SendClick(917,688);
Sleep(2200);
SendClick(917,688);
amount := StrToInt(Label3.Caption) + 1;
Label3.Caption := IntToStr(amount);
end;
for some reason it repeats only 1 time and stops... can anyone spot a problem? im pretty tired and ive went over and over it a few times and i can't seem to see one...
I is a uninitialized local variable (it contains garbage), so the result of the comparision if i > StrToInt(Edit1.Text) is random.
You may want to add a member variable to your form's class, initialize at the proper time and check it's value on the onTimer event, something like:
type
TForm1 = class(TForm)
..
private
FTimerCount: Integer;
FMaxTimerCount: Integer;
..
procedure TForm1.Button1Click(Sender: TObject);
begin
FTimerCount := 0;
FMaxTimerCount := 20; //the timer will fire 20 times.
Timer1.Enabled := True;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Inc(FTimerCount);
Timer1.Enabled := FTimerCount < FMaxTimerCount;
DoOtherStuff();
end;
The line
i :=+ 1;
assigns the value +1 (also known as 1) to the variable named i. (That is, if i is equal to 55, and you do i :=+ 1, then i will be equal to 1.)
Perhaps you are seeking
i := i + 1;
or
inc(i);
?
You're not initializing i, it is a local variable. Hence the timer can be enabled or not depending on the arbitrary value it's memory location holds.
This is a well case that people just ignore the Warning message.
I wish that compiler should spit out Hint or Error and No Warning. Warning is just a case that short comming from compiler and it should be fixed at later version.
Cheers
Related
I am finding difficulty in finding a solution for this. I am designing a simulation application and need to display graphs at certain intervals. I have a TTrackBar. I want to increment its values with a delay of 500ms between each step increase.
I wrote this method which is called from FormShow(Sender: TObject) procedure
PROCEDURE playTrackBar (t: Real);
VAR
v : REAL;
BEGIN
v := t;
while <CONDITION> do
BEGIN
v := v + 1;
if (v >= Form4.TrackBar1.Max) then
BEGIN
v := 0;
END;
Form4.TrackBar1.Value := v;
sleep(500);
END;
END;
I was looking for an event like trackbar.isClicked() which returns a boolean value so I could stop the while loop, but couldn't find any such function. When I used the value true at <CONDITION>, the application crashed (possibly because of the infinite loop).
Need some help in finding what the <CONDITION> should be. Would accept if any other possible solutions to achieve auto-incrementing/auto-playing the track bar is provided.
A program must not allocate all CPU resources. When you update a GUI component or wants input from the user, there must be time for the system to reflect those events. A sleep call is not the correct way to do this.
Use a TTimer event to animate the trackbar.
Put the TTimer on your form and set Enabled to false. Add an OnTimer event:
procedure TMyForm.OnTimer1(Sender: TObject);
var
trackPos : Integer;
begin
trackPos := TrackBar1.Value;
if trackPos >= TrackBar1.Max then begin // Time to stop animation
Timer1.Enabled := False; // Or move this line to another event
TrackBar1.Value := 0; // Reset the value to zero
Exit;
end;
TrackBar1.Value := trackPos + 1;
end;
In your form Show event, set the update interval and start the timer:
procedure TMyForm.FormShow(Sender: TObject);
begin
TrackBar1.Max := 200;
TrackBar1.Value := 0;
Timer1.Interval := 500;
Timer1.Enabled := True; // Start the animation
end;
The animation stops when the trackbar value reaches the maximum value.
If you want to stop the animation by an event (user clicks on something),
just move the timer enabled setting into this event.
I've hit an issue when trying to delete layers using Graphics32. It seems that unless you delete layers in reverse order (from the last added to the first) an exception is thrown. I created the simplest application to test this and it is repeatable every time.
I created a simple form with a TImgView32 component (properties all at default) then a button which does the following:
procedure TMainForm.btnDeleteTestClick(Sender: TObject);
var
Layer1: TCustomLayer;
Layer2: TCustomLayer;
begin
Layer1 := TCustomLayer.Create(ImageView.Layers);
Layer2 := TCustomLayer.Create(ImageView.Layers);
Layer1.Free;
Layer2.Free;
end;
If I reverse the order (Layer2.Free then Layer1.Free) it works fine, but this way round it crashes every time. It's also the same whether I use TCustomLayer, TPositionedLayer, TBitmapLayer, or whatever.
I've traved the error and the fault seems to originate here:
function TPointerMap.Delete(BucketIndex, ItemIndex: Integer): PData;
begin
with FBuckets[BucketIndex] do begin
Result := Items[ItemIndex].Data;
if FCount = 0 then Exit;
Dec(Count);
if Count = 0 then SetLength(Items, 0)
else if (ItemIndex < Count) then
Move(Items[ItemIndex + 1], Items[ItemIndex], (Count - ItemIndex - 1) * SizeOf(TPointerBucketItem));
end;
Dec(FCount);
end;
Any idea what is causing this or if I'm doing something wrong? I'm running Delphi XE, by the way.
Here's the code for TCustomLayer.Destroy
destructor TCustomLayer.Destroy;
var
I: Integer;
begin
if Assigned(FFreeNotifies) then
begin
for I := FFreeNotifies.Count - 1 downto 0 do
begin
TCustomLayer(FFreeNotifies[I]).Notification(Self);
if FFreeNotifies = nil then Break;
end;
FFreeNotifies.Free;
FFreeNotifies := nil;
end;
SetLayerCollection(nil); <<-- bug, see below.
inherited; <<---- See note below.
end;
Notice that there's a bug in SetLayerCollection.
Buggy code
procedure TCustomLayer.SetLayerCollection(Value: TLayerCollection);
begin
if FLayerCollection <> Value then begin
if Assigned(FLayerCollection) then begin
if FLayerCollection.MouseListener = Self then
FLayerCollection.MouseListener := nil;
FLayerCollection.RemoveItem(Self);
end;
if Assigned(Value) then Value.InsertItem(Self);
end;
/// FLayerCollection is never set!
end;
The line SetLayerCollection(nil); does not actually set the LayerCollection!
The internal FLayerCollection can suffer from a use after free condition, which is possibly what's happening to you.
Change the code for SetLayerCollection like so:
Bug fix
procedure TCustomLayer.SetLayerCollection(Value: TLayerCollection);
begin
if FLayerCollection <> Value then begin
if Assigned(FLayerCollection) then begin
if FLayerCollection.MouseListener = Self then begin
FLayerCollection.MouseListener := nil;
end;
FLayerCollection.RemoveItem(Self);
end;
if Assigned(Value) then begin
Value.InsertItem(Self)
end;
FLayerCollection:= Value; // add this line.
end;
end;
Note
My hypothesis is that the following snippet causes the error:
SetLayerCollection(nil);
inherited;
SetLayerCollection(value); leaves FLayerCollection unchanged.
The inherited destructor somehow calls something having to do with LayerCollection.
Let me know if this fixes the error.
I've filed a new issue: https://github.com/graphics32/graphics32/issues/13
Update: issue is off by one error in TPointerMap.Delete
The actual issue is here:
https://github.com/graphics32/graphics32/issues/14
The code for TPointerMap.Delete is incorrect:
function TPointerMap.Delete(BucketIndex, ItemIndex: Integer): PData;
begin
with FBuckets[BucketIndex] do
begin
Result := Items[ItemIndex].Data;
if FCount = 0 then Exit; <<-- error: how can result be valid if count = 0?
Dec(Count);
if Count = 0 then
SetLength(Items, 0)
else
if (ItemIndex < Count) then
//Oops off by 1 error! ---------------------------------------VVVVV
Move(Items[ItemIndex + 1], Items[ItemIndex], (Count - ItemIndex - 1) * SizeOf(TPointerBucketItem));
end;
Dec(FCount); <<-- The use of with makes this statement confusing.
end;
The code should be changed as follows:
function TPointerMap.Delete(BucketIndex, ItemIndex: Integer): PData;
var
Bucket: TPointerBucket ;
begin
if FCount = 0 then Exit(nil);
//Perhaps add some code to validate BucketIndex & ItemIndex?
Assert(BucketIndex < Length(FBuckets));
Bucket:= FBuckets[BucketIndex];
if ItemIndex >= Bucket.
Assert(ItemIndex < Length(Bucket.Items));
Result := Bucket.Items[ItemIndex].Data;
Dec(Bucket.Count);
if Bucket.Count = 0 then
SetLength(Bucket.Items, 0)
else
/// assume array like so: 0 1 2 3 4 , itemindex = 0
/// result should be 1 2 3 4
/// move(1,0,4) (because 4 items should be moved.
/// Thus move (itemindex+1, intemindex, count-itemindex)
if (ItemIndex < Bucket.Count) then
Move(Items[ItemIndex + 1], Items[ItemIndex], (Bucket.Count - ItemIndex) * SizeOf(TPointerBucketItem));
end;
Dec(FCount);
end;
In the Jvdbgrid1 table, I always have only two ClientDataSet records.
When I am on the first record, how to go on the second record and conversely.
When I am on the second record, how to go on the first record.
So (buttonClick) once the record is +1 once -1
How to save this in code?
When you are on the second record and want to get to the first one, just call
ClientDataSet1.MoveBy(-1)
When on the first record, to get to the second, call
ClientDataSet1.MoveBy(1)
But if you want your app to do this automatically, it's easier to use .Next and .Prior, as in
procedure TForm1.ToggleRecord;
begin
ClientDataSet1.Next;
if ClientDataSet1.Eof then
ClientDataset1.Prior;
end;
Update The cleanest/simplest equivalent to what you do in your answer seems to be
procedure TForm1.PlayFile;
begin
ShowMessage(IntToStr(ClientDataSet1.RecNo));
end;
procedure TForm1.ToggleRecord2;
var
Distance : Integer;
begin
if ClientDataSet1.RecNo = 2 then
Distance := -1
else
Distance := 1;
ClientDataSet1.MoveBy(Distance);
PlayFile;
Distance := - Distance;
ClientDataSet1.MoveBy(Distance);
end;
but it is pretty much a matter of taste. Ymmv ...
In the end I succeeded :)
That's exactly what I meant. Question to you.
You can write this code more sensibly (better)
procedure TForm1.btn1Click(Sender: TObject);
begin
if assigned(idictionary) then
begin
if ClientDataSet1.RecNo = 1 then
begin
ClientDataSet1.Next;
PlayFile;
ClientDataSet1.Prior;
end;
if ClientDataSet1.RecNo = 2 then
begin
ClientDataSet1.Prior;
PlayFile;
ClientDataSet1.Next;
end;
end;
end;
im a beginner to Aplication forms in Delphi, i need a little help please. So its basically a program that does Aritmetic count for numbers from
Memo box. I wanna also add interval to it. (-15;20> And i wanna do it for all ODD numbers.
Variables are listed here
soucet:SUM,
pocet:count of numbers,
Prumer:Arithmetic mean
procedure TForm1.Button3Click(Sender: TObject);
var soucet,prumer,x: Real;
i,pocet:Integer;
begin
Memo1.Clear;
soucet:=0;
pocet:=0;
i:=0;
While i<= Memo1.Lines.Count-1 do begin --
x:=StrToFloat (Memo1.lines[i]); --
If (x>-5) and (x<=5) then begin
soucet:= soucet + x;
inc(pocet);
end;
inc(i);
end;
If pocet>0 then begin
prumer:=soucet/pocet;
Memo1.Text:= floattostr(prumer);
end
else Memo1.Text:= 'Žádná čísla z intervalu (-15;20>';
But i only want this code to be for ODD numbers...
procedure TForm1.Button3Click(Sender: TObject);
var soucet,prumer,x: Real;
i,pocet:Integer;
begin
Memo1.clear;
soucet:=0;
pocet:=0;
i:=0;
While i<= Memo1.Lines.Count-1 do begin --
x:=StrToFloat (Memo1.lines[i]); --
If (x>-5) and (x<=5) then begin
If x mod 2<>0 then begin
soucet:= soucet + x;
inc(pocet);
end;
end;
inc(i);
end;
If pocet>0 then begin
prumer:=soucet/pocet;
Memo1.Text:= floattostr(prumer);
end
else Memo1.Text:= 'Žádná čísla z intervalu (-15;20>';
The problem is that it shows : Operator not aplicable to this operand type.
What should i do to remove this error ?
You have your xdeclared as real but the modoperator works on integer
Either
Declare x as integer and use StrToInt, TryStrToInt or StrToIntDef io StrToFloat
Truncate the real to an int like this: if Trunc(x) mod 2 <> 0 or even better use the built-in odd function like this: if odd(Trunc(x))
This will solve your immediate problem but you might want to read up on
input validation
clean code
and not related to your current code but important enough to mention
error/resource handling (try...finally)
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,