Ok here's the thing, my program runs perfect.. no errors at all until I add another button onto my form.
I have a stringgrid in parallel with an array[1..200].
I have a delete button:
Procedure TForm1.DeleteTeam(TeamName: string);
var
i : integer;
begin
for i := 1 to TotalNumberOfTeams do
begin
if TeamName = SailingTeams[i].TeamName then
begin
sailingTeams[i].AvLapTime := 99999999;
//puts one to delete with largest value to delete
SortArray;
//sorts it so it is at the end of array
sailingTeams[TotalNumberOfTeams] := nil;
TotalNumberOfTeams := TotalNumberOfTeams - 1;
sortArray;
UpdateGrid;
Break;
end;
end;
end;
procedure TForm1.btnDeleteClick(Sender: TObject);
var
TeamName : string;
continue : integer;
begin
TeamName := (strGrid.Cells[0,(strGrid.Row)]);
continue := MessageDlg('Are you sure you wish to delete: '+teamName+'?',mtWarning, mbYESNO, 0);
if continue = mrYES then
DeleteTeam(TeamName);
end;
If I add a button and click it, then click delete I get the error :S :S
Just a home project for a 24 hour dingy race so efficiency of algorithms and stuff not important but any ideas as to why I'm getting this error?? :S
Related
I am currently doing a school project, I am making a Credit Card machine. I need the 'Enter Button' to
run different code when it is clicked. The first click must get the card number from an edit ps... (I clear the edit once the card number has been retrieved), and the second click must get the pin from the same edit.
How would I do this?
procedure TfrmMainMenu.btbtnEnterClick(Sender: TObject);
var
sCvv,sPin:string;
begin
iCount2:=0;
sCardNumber:=lbledtCardInfo.Text;
if (Length(sCardNumber)<>16) AND (iCount2=0) then
begin
ShowMessage('Card number has to 16 digits,please try again!!');
end
else
begin
Inc(iCount2);
lbledtCardInfo.clear;
lbledtCardInfo.EditLabel.Caption:='Enter Pin' ;
btbtnEnter.Enabled:=false;
end; //if
if iCount2=2 then
begin
btbtnEnter.Enabled:=true;
sPin:=lbledtCardInfo.Text;
ShowMessage(sPin);//returns a blank
end;
You could try to do everything in a single event handler. There are several different ways to handle that. However, a different solution would be to use separate event handlers for each task, and then each task can assign a new handler for the next click to perform, eg:
procedure TfrmMainMenu.FormCreate(Sender: TObject);
begin
// you can set this at design-time if desired...
btbtnEnter.OnClick := GetCCNumber;
end;
procedure TfrmMainMenu.GetCCNumber(Sender: TObject);
begin
sCardNumber := lbledtCardInfo.Text;
if Length(sCardNumber) <> 16 then
begin
ShowMessage('Card number has to 16 digits,please try again!!');
Exit;
end;
lbledtCardInfo.Clear;
lbledtCardInfo.EditLabel.Caption := 'Enter Pin' ;
btbtnEnter.OnClick := GetCCPin;
end;
procedure TfrmMainMenu.GetCCPin(Sender: TObject);
var
sPin: string;
begin
sPin := lbledtCardInfo.Text;
if Length(sPin) <> 4 then
begin
ShowMessage('Card Pin has to 4 digits,please try again!!');
Exit;
end;
ShowMessage(sPin);
...
lbledtCardInfo.Clear;
lbledtCardInfo.EditLabel.Caption := 'Enter Number' ;
btbtnEnter.OnClick := GetCCNumber;
end;
A variation of this would be to create multiple buttons that overlap each other in the UI, and then you can toggle their Visible property back and forth as needed, eg:
procedure TfrmMainMenu.FormCreate(Sender: TObject);
begin
// you can set this at design-time if desired...
btbtnCCPinEnter.Visible := False;
btbtnCCNumEnter.Visible := True;
end;
procedure TfrmMainMenu.btbtnCCNumEnterClick(Sender: TObject);
begin
sCardNumber := lbledtCardInfo.Text;
if Length(sCardNumber) <> 16 then
begin
ShowMessage('Card number has to 16 digits,please try again!!');
Exit;
end;
lbledtCardInfo.Clear;
lbledtCardInfo.EditLabel.Caption := 'Enter Pin' ;
btbtnCCNumEnter.Visible := False;
btbtnCCPinEnter.Visible := True;
end;
procedure TfrmMainMenu.btbtnCCPinEnterClick(Sender: TObject);
var
sPin: string;
begin
sPin := lbledtCardInfo.Text;
if Length(sPin) <> 4 then
begin
ShowMessage('Card Pin has to 4 digits,please try again!!');
Exit;
end;
ShowMessage(sPin);
...
lbledtCardInfo.Clear;
lbledtCardInfo.EditLabel.Caption := 'Enter Number' ;
btbtnCCPinEnter.Visible := False;
btbtnCCNumEnter.Visible := True;
end;
Notice that you test iCount2 = 0 immediately after setting iCount2 := 0. Thus, that test will always be True. Furthermore, the later test iCount2 = 2 will always be False because the value starts at 0 and you only have one Inc in between.
Instead try the following.
Add two string fields FCardNumber and FPin to your form class:
private
FCardNumber: string;
FPin: string;
Also create an enumerated type TEntryStage = (esCardNumber, esPin) and add a field of this type. This will make your code look like this:
private
type
TEntryStage = (esCardNumber, esPin);
var
FCardNumber: string;
FPin: string;
FEntryStage: TEntryStage;
In Delphi, class fields (class member variables) are always initialized, so FEntryStage will be esCardNumber (=TEntryStage(0)) when the form is newly created.
Add a TLabeledEdit (I see you use those) and a TButton; name them eInput and btnNext, respectively. Let the labeled edit's caption be Card number: and the caption of the button be Next.
Now add the following OnClick handler to the button:
procedure TForm1.btnNextClick(Sender: TObject);
begin
case FEntryStage of
esCardNumber:
begin
// Save card number
FCardNumber := eInput.Text;
// Prepare for the next stage
eInput.Clear;
eInput.EditLabel.Caption := 'Pin:';
FEntryStage := esPin;
end;
esPin:
begin
// Save pin
FPin := eInput.Text;
// Just do something with the data
ShowMessageFmt('Card number: %s'#13#10'Pin: %s', [FCardNumber, FPin]);
end;
end;
end;
You might notice that you cannot trigger the Next button using Enter, which is very annoying. To fix this, do
procedure TForm1.eInputEnter(Sender: TObject);
begin
btnNext.Default := True;
end;
procedure TForm1.eInputExit(Sender: TObject);
begin
btnNext.Default := False;
end;
Much better!
Is there a way to delete all children from a TTreeViewItem? I tried DeleteChildren but that causes crashes.
What I thought what was a simple question turns out to generate many more questions. That's why I explain of what I am trying to do.
My application tries to generate a directory tree in Delphi XE5 FMX. I use TTreeView for that. It starts by generating a list of drives, all of them TTreeViewItem's owned by TTreeView. When the user clicks on an item the directories below are added to the directory and the TTreeViewItem clicked upon expands. When the user clicks again the TTreeViewItem callapses. This has one caveat: the next time the user clicks on the same TTreeViewItem, the list of directories are added to the existing ones, see image below. In order to prevent that I would like to first clear the current list.
When I tried to delete the children using TreeViewItem.DeleteChildren from a TTreeViewItem I get an exception at another spot, see the picture below.
As to some questions: yes, I am sure I only add TTreeViewItems and this is the only Control I assign the OnClick event (import_directory_click). I have added the complete code and commented out the non-essentials to be sure.
I hope somebody tells me this functionality already exists (couldn't find it) but even then I would still like to know how to manage a TTreeView.
procedure TMain.import_initialize;
var
Item: TTreeViewItem;
drive: Char;
start: string;
begin
Directory_Tree.Clear;
{$IFDEF MSWINDOWS}
// When Windows, just present a list of all existing drives
for drive := 'C' to 'Z' do
begin
// A drive exists when its root directory exists
start := drive + ':\';
if TDirectory.Exists (start) then import_add (start, Directory_Tree);
end; // for
{$ELSE}
// All other systems are unix systems, start with root.
drive := '/';
start:= drive;
Item := import_add (TPath.GetPathRoot (start), DirectoryTree);
import_get_dirs (Item, start);
{$ENDIF}
start := TPath.GetSharedPicturesPath;
import_add (start, Directory_Tree);
if start <> TPath.GetPicturesPath
then import_add (TPath.GetPicturesPath, Directory_Tree);
// import_test_selection ('');
end; // import_initialize //
procedure TMain.import_directory_click (Sender: TObject);
var
TreeItem: TTreeViewItem;
obj: TFMXObject;
first_file: string;
begin
GridPanelLayout.Enabled := False;
if Sender <> nil then
begin
TreeItem := Sender as TTreeViewItem;
if TreeItem.IsExpanded then
begin
TreeItem.CollapseAll;
end else
begin
TreeItem.DeleteChildren; // <== this statement
import_get_dirs (TreeItem, TreeItem.Text);
{
first_file := find_first (TreeItem.Text, Selected_Images);
if first_file <> '' then
begin
Image.Bitmap.LoadFromFile (first_file);
GridPanelLayout.Enabled := True;
end; // if
}
TreeItem.Expand; // <== causes an exception over here
end; // if
end; // if
end; // import_directory_click //
procedure TMain.import_get_dirs (Start_Item: TTreeViewItem; start: string);
var
DirArray: TStringDynArray;
DirArraySize: Int32;
i: Int32;
begin
DirArray := TDirectory.GetDirectories (start);
DirArraySize := Length (DirArray);
for i := 0 to DirArraySize - 1
do import_add (DirArray [i], Start_Item);
end; // get_dirs //
function TMain.import_add (dir: string; owner: TControl): TTreeViewItem;
var
TreeItem: TTreeViewItem;
begin
TreeItem := TTreeViewItem.Create (owner);
TreeItem.text := dir;
TreeItem.OnClick := import_directory_click;
// TreeItem.Parent := owner;
owner.AddObject (TreeItem);
Result := TreeItem;
end; // import_add //
It seems that TreeItem.DeleteChildren deletes the item content site instead of the subitems.
I suggest to use this:
for i := TreeItem.Count - 1 downto 0 do
TreeItem.RemoveObject(TreeItem.Items[i]);
This question is unlikely to help any future visitors; it is only relevant to a small geographic area, a specific moment in time, or an extraordinarily narrow situation that is not generally applicable to the worldwide audience of the internet. For help making this question more broadly applicable, visit the help center.
Closed 10 years ago.
I have a button and when clicked, i would like for a TMachine (aka TShape) to show up on the form. Currenty i get no errors, but it never shows up on the form.
Code for button click
procedure TfDeptLayout.bAddMachineClick(Sender: TObject);
var
machine: TMachine;
shapeAsset,
shapeShape,
shapeNumber,
shapeName: string;
begin
if not OkToAdd() then
begin
ShowMessage('Please fill out form correctly!');
Exit;
end;
ShapeAsset := Edit2.text;
ShapeShape := Combobox1.Text;
ShapeNumber := Edit3.Text;
ShapeName := Edit1.Text;
if sub = false then
begin
machine := TMachine.Create(self);
machine.Parent := Self;
machine.PlaceShape(0, FDB.GetWW(ShapeShape), FDB.GethW(ShapeShape),
'20', '20', ShapeName, ShapeNumber, ShapeAsset)
//show save button
//lockout add machine button
//let user place machine top / left.
//save all locations
//save top and left for each tmachine to database
//lockout save button
//show add machine button
end;
if sub then
ShowMessage('auto save form');
ShowMessage('congrats you added a machine');
end;
if needed i can show the TMachine unit?..
type
TMachine = class(TShape)
private
FOnMouseEnter: TNotifyEvent;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
protected
procedure DoMouseEnter; virtual;
published
property OnMouseEnter: TNotifyEvent Read FOnMouseEnter write FOnMouseEnter;
public
mnName: string;
mnAsset: string;
mnNumber: string;
mnIsPanel: string;
mnBasicName: string;
mnLShape: string;
procedure PlaceShape(AM, sizeW, sizeH: Integer; ptop, pleft, name, order,
asset: string);
end;
implementation
uses
deptlayout;
procedure TMachine.CMMouseEnter(var Message: TMessage);
begin
DoMouseEnter;
inherited;
end;
procedure TMachine.DoMouseEnter;
begin
if Assigned(FOnMouseEnter) then
FOnMouseEnter(Self);
end;
procedure TMachine.PlaceShape(AM, sizeW, sizeH: Integer; ptop, pleft, name,
order, asset: string);
var
myLabel: TLabel;
begin
if ptop = '0' then
Top := 136
else
Top := StrToInt(ptop);
Width := sizeW;
Height := sizeH;
if pleft = '0' then
Left := MyDataModule.fDB.LastX + 2 //set left
else
Left := StrToInt(pleft);
MyDataModule.fDB.lastx := Left + sizeW;
if AM = 1 then //if in edit mode..
begin
//create label put inside the shape.
myLabel := TLabel.Create(FDeptLayout);
mylabel.Parent := FDeptLayout;
mylabel.Left := Left;
mylabel.Top := Top + 8;
mylabel.Caption := '#' + mnNumber;
end;
end;
end.
Of course it doesn't work!
The code that adds the machine is inside if not OkToAdd() then, so it will only run if not OkToAdd. BUT! Even if this is the case, you Exit before you run the code! Hence, the code will never run!
Probably you mean it to be like this:
if not OkToAdd then
begin
ShowMessage('Please fill out form correctly!');
Exit;
end; //END!!!!!!
To summarise my comments above:
Change the refer to fDeptLayout to Self, as you have done in your edit:
procedure TfDeptLayout.bAddMachineClick(Sender: TObject);
var
machine : TMachine;
shapeAsset,
shapeShape,
shapeNumber,
shapeName : string;
begin
if not OkToAdd() then
begin
showmessage('Please fill out form correctly!');
Exit;
End;
shapeAsset := edit2.text;
ShapeShape := Combobox1.Text;
ShapeNumber := Edit3.Text;
ShapeName := Edit1.Text;
if sub = false then
begin
machine := TMachine.Create(self);
machine.Parent := Self;
machine.PlaceShape(0,FDB.GetWW(ShapeShape),FDB.GethW(ShapeShape),'20','20',ShapeName,ShapeNumber,ShapeAsset)
//show save button
//lockout add machine button
//let user place machine top / left.
//save all locations
//save top and left for each tmachine to database
//lockout save button
//show add machine button
end;
if sub then
showmessage('auto save form');
showmessage('congrats you added a machine');
end;
To avoid confusion in future, delete the global form variables that the Delphi IDE creates for all but the main form, and any other autocreated forms - they are rarely if ever needed, and "pollute the namespace"
Unknown why this solved it, but after trying to find the parent for Machine by putting
showmessage('Machine Parent: '+Machine.parent.name);
it was giving access errors.
Deleted
Machine.parent := self;
Compile, build. Then reaadded
Machine.parent := self;
and everything worked.
Ok guys, I've been trying to find out every possible mistake i'm making but I give up... I need help! What I'm writing is an app to manage rentals for my job and when the date is past, my app removes the name from 2 text files. I wrote 3 little functions(procedures) to make this work. Here:
This one loads from dates.dat file and remove the line containing the name of the employee.
procedure remDate(emp: String);/// Removes employee from date file
var
pos1, i: integer;
dateList: TStringList;
begin
dateList:=TStringList.Create;
dateList.LoadFromFile('Data\dates.dat');
for i:=0 to dateList.Count-1 do begin
pos1:=AnsiPos(emp, dateList[i]);
if pos1<>0 then begin
dateList.Delete(i);
dateList.SaveToFile('Data\dates.dat');
end;
end;
dateList.Free;
end; //eo remDate
This one removes the line containing the employee name from the perm.dat file.
procedure remPerm(emp: String);/// Removes employee from perm file
var
pos1, i: integer;
permList: TStringList;
begin
permList:=TStringList.Create;
permList.LoadFromFile('Data\perm.dat');
for i:=0 to permList.Count-1 do begin
pos1:=AnsiPos(emp, permList[i]);
if pos1<>0 then begin
permList.Delete(i);
permList.SaveToFile('Data\perm.dat');
end;
end;
permList.Free;
end; //eo remPerm
This one sticks those together. The isDue is a simple function that compares 2 dates and returns a TRUE if date is today or is past.
procedure updatePerms;
var
empList: TStringList;
i: integer;
begin
empList:=TStringList.Create;
empList.LoadFromFile('Data\employes.dat');
for i:=0 to empList.Count-1 do begin
if isDue(empList[i]) then begin
remDate(empList[i]);
remPerm(empList[i]); (*) Here is where the error points.
end;
end;
empList.Free;
end;
The error I get is when it gets to remPerm in the updatePerms procedure.(*)
I get a EStringList Error, out of bound (#). Figured out with many tries that it only happens when an employee's due date is today. Please comment if you need more info!
Thanks in advance, any help is really appreciated!
The problem is that you are using a for loop. The end point of a for loop is only evaluated once when the loop is entered. At that point you may have 100 items, but once you start deleting there will be less. This will then result in a list index out of bounds error.
The simple fix is to reverse the for loop:
procedure remDate(emp: String);
/// Removes employee from date file
var
pos1, i: integer;
dateList: TStringList;
begin
dateList := TStringList.Create;
dateList.LoadFromFile('Data\dates.dat');
for i := dateList.Count - 1 downto 0 do
begin
pos1 := AnsiPos(emp, dateList[i]);
if pos1 <> 0 then
begin
dateList.Delete(i);
dateList.SaveToFile('Data\dates.dat');
end;
end;
dateList.Free;
end; // eo remDate
This will work if the employee occurs more than once.
However if the employee does only occur once, you can use break to exit from the loop early:
procedure remDate(emp: String);
/// Removes employee from date file
var
pos1, i: integer;
dateList: TStringList;
begin
dateList := TStringList.Create;
dateList.LoadFromFile('Data\dates.dat');
for i := 0 to dateList.Count - 1 do
begin
pos1 := AnsiPos(emp, dateList[i]);
if pos1 <> 0 then
begin
dateList.Delete(i);
dateList.SaveToFile('Data\dates.dat');
Break; // <-- early exit
end;
end;
dateList.Free;
end; // eo remDate
Another solution is to use a while loop.
Is there a feature in the Listview control to shift items up and down?
Not having worked with TListView very much (I mostly use database grids), I took your question as a chance to learn something. The following code is the result, it is more visually oriented that David's answer. It has some limitations: it will only move the first selected item, and while it moves the item, the display for vsIcon and vsSmallIcon is strange after the move.
procedure TForm1.btnDownClick(Sender: TObject);
var
Index: integer;
temp : TListItem;
begin
// use a button that cannot get focus, such as TSpeedButton
if ListView1.Focused then
if ListView1.SelCount>0 then
begin
Index := ListView1.Selected.Index;
if Index<ListView1.Items.Count then
begin
temp := ListView1.Items.Insert(Index+2);
temp.Assign(ListView1.Items.Item[Index]);
ListView1.Items.Delete(Index);
// fix display so moved item is selected/focused
ListView1.Selected := temp;
ListView1.ItemFocused := temp;
end;
end;
end;
procedure TForm1.btnUpClick(Sender: TObject);
var
Index: integer;
temp : TListItem;
begin
// use a button that cannot get focus, such as TSpeedButton
if ListView1.Focused then
if ListView1.SelCount>0 then
begin
Index := ListView1.Selected.Index;
if Index>0 then
begin
temp := ListView1.Items.Insert(Index-1);
temp.Assign(ListView1.Items.Item[Index+1]);
ListView1.Items.Delete(Index+1);
// fix display so moved item is selected/focused
ListView1.Selected := temp;
ListView1.ItemFocused := temp;
end;
end;
end;
You have two options:
Delete them and then re-insert them at the new location.
Use a virtual list view and move them in your data structure.
My routine for doing the first of these options is like this:
procedure TBatchTaskList.MoveTasks(const Source: array of TListItem; Target: TListItem);
var
i, InsertIndex: Integer;
begin
Assert(IsMainThread);
BeginUpdate;
Try
//work out where to move them
if Assigned(Target) then begin
InsertIndex := FListItems.IndexOf(Target);
end else begin
InsertIndex := FListItems.Count;
end;
//create new items for each moved task
for i := 0 to high(Source) do begin
SetListItemValues(
FListItems.Insert(InsertIndex+i),
TBatchTask(Source[i].Data)
);
Source[i].Data := nil;//handover ownership to the new item
end;
//set selection and focus item to give feedback about the move
for i := 0 to high(Source) do begin
FListItems[InsertIndex+i].Selected := Source[i].Selected;
end;
FBatchList.ItemFocused := FListItems[InsertIndex];
//delete the duplicate source tasks
for i := 0 to high(Source) do begin
Source[i].Delete;
end;
Finally
EndUpdate;
End;
end;
The method SetListItemValues is used to populate the columns of the list view.
This is a perfect example of why virtual controls are so great.