i would like to make a list of names and then make a random selection but all of them should be called. off course not repeated. delphi code
My suggestion is to make a list of names and then shuffle the name then call it one by one.
i hope this code will work for you.
...
private
{ Private declarations }
FNameList : TStringList;
FNameIndex: Integer;
public
{ Public declarations }
end;
...
procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
begin
Randomize;
FNameIndex := 0;
FNameList := Tstringlist.Create;
// FNameList.LoadFromFile('NameList.txt'); or
FNameList.Add('Name 1');
FNameList.Add('Name 2');
FNameList.Add('Name 3');
FNameList.Add('Name 4');
FNameList.Add('Name 5');
FNameList.Add('Name 6');
for i:= 1 to 100 do // shuffle 100 times. its up to you
FNameList.Exchange(Random(FNameList.Count-1), Random(FNameList.Count-1));
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FNameList.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if FNameIndex < FNameList.Count then
begin
showmessage(FNameList.Strings[FNameIndex]);
inc(FNameIndex);
end else showmessage('Done!');
end;
Well I can not deliver you delphi code but I have quite the same problem here. I am using a list of Names (with addresses) from this website http://de.fakenamegenerator.com.
Maybe it's a little help.
I'm not into delphi, but the algorithm is quite straightforwarded. Just insert names into a List with a random generated index. This way you have a randomly sorted List of names. Then just iterate over it.
Make a copy of the names into List and execute the following:
// assuming list is a stringlist containing the names
while List.Count > 0 do begin
idx := Random(List.Count);
// do something with List[idx]
List.Delete(idx);
end;
Related
Short Version: Is there any way to control or modify LisBox items individually? for example set their Visible property to False separately.
I found a TListBoxItem class in Fire Monkey when I was searching, but I don't want to use Fire Monkey and want it in VCL.
Detailed Version:
I tried to filter my ListBox using two TStringList and an Edit, one StringList is global to keep the original list (list_files_global) and another StringList to help filtering procedure (list_files_filter) and my primary list of files is my ListBox (list_files).
I created my global StringList on onCreate event while program is starting to store my original list:
procedure Tfrm_main.FormCreate(Sender: TObject);
Begin
list_files_global := TStringList.Create;
list_files_global.Assign(list_files.Items);
End;
and used Edit's onChange event for filtering:
procedure Tfrm_main.edit_files_filterChange(Sender: TObject);
Var
list_files_filter: TStringList;
i: Integer;
Begin
list_files_filter := TStringList.Create;
list_files_filter.Assign(list_files.Items);
list_files.Clear;
for i := 0 to list_files_filter.Count - 1 do
if pos(edit_files_filter.text, list_files_filter[i]) > 0 then
list_files.Items.Add(list_files_filter[i]);
End;
and for switching off the filter, just recover the list from my global list that I created at first:
list_files.Items := list_files_global;
here so far, everything works just fine, but problem is when I'm trying to edit/rename/delete items from filtered list, for example I change an item:
list_files.Items[i] := '-- Changed Item --';
list will be edited, but when I switch off the filter, the original list will be back and all changes are lost.
so I want to know is there any proper way to solve this problem? Something like hiding items individually or change items visibility, etc... so I can change the filtering algorithm and get rid of all this making extra lists.
I searched the internet and looked into Delphi's help file for a whole day and nothing useful came up.
The items of a VCL listbox, List Box in the API, does not have any visibility property. The only option for not showing an item is to delete it.
You can use the control in virtual mode however, where there are no items at all. You decide what data to keep, what to display. That's LBS_NODATA window style in the API. In VCL, set the style property to lbVirtual.
Extremely simplified example follows.
Let's keep an array of records, one record per virtual item.
type
TListItem = record
FileName: string;
Visible: Boolean;
end;
TListItems = array of TListItem;
You can extend the fields as per your requirements. Visibility is one of the main concerns in the question, I added that. You'd probably add something that represents the original name so that you know what name have been changed, etc..
Have one array per listbox. This example contains one listbox.
var
ListItems: TListItems;
Better make it a field though, this is for demonstration only.
Required units.
uses
ioutils, types;
Some initialization at form creation. Empty the filter edit. Set listbox style accordingly. Fill up some file names. All items will be visible at startup.
procedure TForm1.FormCreate(Sender: TObject);
var
ListFiles: TStringDynArray;
i: Integer;
begin
ListFiles := ioutils.TDirectory.GetFiles(TDirectory.GetCurrentDirectory);
SetLength(ListItems, Length(ListFiles));
for i := 0 to High(ListItems) do begin
ListItems[i].FileName := ListFiles[i];
ListItems[i].Visible := True;
end;
ListBox1.Style := lbVirtual;
ListBox1.Count := Length(ListFiles);
Edit1.Text := '';
end;
In virtual mode the listbox is only interested in the Count property. That will arrange how many items will show, accordingly the scrollable area.
Here's the filter part, this is case sensitive.
procedure TForm1.Edit1Change(Sender: TObject);
var
Text: string;
Cnt: Integer;
i: Integer;
begin
Text := Edit1.Text;
if Text = '' then begin
for i := 0 to High(ListItems) do
ListItems[i].Visible := True;
Cnt := Length(ListItems);
end else begin
Cnt := 0;
for i := 0 to High(ListItems) do begin
ListItems[i].Visible := Pos(Text, ListItems[i].FileName) > 0;
if ListItems[i].Visible then
Inc(Cnt);
end;
end;
ListBox1.Count := Cnt;
end;
The special case in the edit's OnChange is that when the text is empty. Then all items will show. Otherwise code is from the question. Here we also keep the total number of visible items, so that we can update the listbox accordingly.
Now the only interesting part, listbox demands data.
procedure TForm1.ListBox1Data(Control: TWinControl; Index: Integer;
var Data: string);
var
VisibleIndex: Integer;
i: Integer;
begin
VisibleIndex := -1;
for i := 0 to High(ListItems) do begin
if ListItems[i].Visible then
Inc(VisibleIndex);
if VisibleIndex = Index then begin
Data := ListItems[i].FileName;
Break;
end;
end;
end;
What happens here is that the listbox requires an item to show providing its index. We loop through the master list counting visible items to find out which one matches that index, and supply its text.
This is something I often do, but with list views instead of list boxes. The basic principles are the same, though.
I tend to store the individual items as objects, which are reference types in Delphi. And I keep them all in one main unfiltered list, which owns the objects, while I maintain a filtered list (which does not own the objects) for display purposes. Like #Sertac, I combine this with a virtual list view.
To see how this works in practice, create a new VCL application and drop a list view (lvDisplay) and an edit control (eFilter) on the main form:
Notice I have added three columns to the list view control: "Name", "Age", and "Colour". I also make it virtual (OwnerData = True).
Now define the class for the individual data items:
type
TDogInfo = class
Name: string;
Age: Integer;
Color: string;
constructor Create(const AName: string; AAge: Integer; const AColor: string);
function Matches(const AText: string): Boolean;
end;
where
{ TDogInfo }
constructor TDogInfo.Create(const AName: string; AAge: Integer;
const AColor: string);
begin
Name := AName;
Age := AAge;
Color := AColor;
end;
function TDogInfo.Matches(const AText: string): Boolean;
begin
Result := ContainsText(Name, AText) or ContainsText(Age.ToString, AText) or
ContainsText(Color, AText);
end;
And let us create the unfiltered list of dogs:
TForm1 = class(TForm)
eFilter: TEdit;
lvDisplay: TListView;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FList, FFilteredList: TObjectList<TDogInfo>;
public
end;
where
function GetRandomDogName: string;
const
DogNames: array[0..5] of string = ('Buster', 'Fido', 'Pluto', 'Spot', 'Bill', 'Rover');
begin
Result := DogNames[Random(Length(DogNames))];
end;
function GetRandomDogColor: string;
const
DogColors: array[0..2] of string = ('Brown', 'Grey', 'Black');
begin
Result := DogColors[Random(Length(DogColors))];
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
FList := TObjectList<TDogInfo>.Create(True); // Owns the objects
// Populate with sample data
for i := 1 to 1000 do
FList.Add(
TDogInfo.Create(GetRandomDogName, Random(15), GetRandomDogColor)
);
FFilteredList := FList;
lvDisplay.Items.Count := FFilteredList.Count;
lvDisplay.Invalidate;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if FFilteredList <> FList then
FreeAndNil(FFilteredList);
FreeAndNil(FList);
end;
The idea is that the list view control always displays the FFilteredList, which either points to the same object instance as FList, or points to a filtered (or sorted) version of it:
// The list view's OnData event handler
procedure TForm1.lvDisplayData(Sender: TObject; Item: TListItem);
begin
if FFilteredList = nil then
Exit;
if not InRange(Item.Index, 0, FFilteredList.Count - 1) then
Exit;
Item.Caption := FFilteredList[Item.Index].Name;
Item.SubItems.Add(FFilteredList[Item.Index].Age.ToString);
Item.SubItems.Add(FFilteredList[Item.Index].Color);
end;
// The edit control's OnChange handler
procedure TForm1.eFilterChange(Sender: TObject);
var
i: Integer;
begin
if string(eFilter.Text).IsEmpty then // no filter, display all items
begin
if FFilteredList <> FList then
begin
FreeAndNil(FFilteredList);
FFilteredList := FList;
end;
end
else
begin
if (FFilteredList = nil) or (FFilteredList = FList) then
FFilteredList := TObjectList<TDogInfo>.Create(False); // doesn't own the objects
FFilteredList.Clear;
for i := 0 to FList.Count - 1 do
if FList[i].Matches(eFilter.Text) then
FFilteredList.Add(FList[i]);
end;
lvDisplay.Items.Count := FFilteredList.Count;
lvDisplay.Invalidate;
end;
The result:
Notice that there always is only one in-memory object for each dog, so if you rename a dog, the changes will reflect in the list view, filtered or not. (But don't forget to invalidate it!)
I don't know Delphi and would someone help me to change a small Delhpi script from vmprotect?
function GetRandomSectionName: String;
var I:Integer;
B:Byte;
begin
Result:='';
for I:=1 to 8 do
begin
B:=32+Random(Ord('z')-32);
Result:=Result+Chr(B);
end;
end;
procedure OnAfterSaveFile;
var I:Integer;
begin
with VMProtector.OutputFile do
for I:=0 to Sections.Count-1 do
Sections.Items[I].Name:=GetRandomSectionName;
end;
It should only randomize the sections which is starting with .vmp the rest should stay.
It should only randomize the sections which is starting with .vmp the rest should stay.
Use the System.Pos function to match a substring in a string.
procedure OnAfterSaveFile;
var I:Integer;
begin
with VMProtector.OutputFile do
for I:=0 to Sections.Count-1 do
if Pos('.vmp',Sections.Items[I].Name) = 1 then // Only .vmp sections
Sections.Items[I].Name:=GetRandomSectionName;
end;
Im going through one of my old exam papers, preparing for my finals, and for the love of life, I cant figure out how to do this!
The program was working earlier, but it wasn't sorting the array. Now Im getting an error saying EAccess violation with message: access violation at address 00404BDE
Here's my code (its kind of long, maybe you can help me spot my error) :
private
{ Private declarations }
iCount : Integer;
arrDams : array [1..200] of string;
Procedure List;
procedure Display;
procedure Sort;
procedure Search (sDam : String);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Display; //Display with Numbers
var
k : Integer;
begin
for K := 1 to 200 do
begin
RedOut.Lines.Add (IntToStr(k) + '.) ' + (arrDams[k]));
end;
end;
procedure TForm1.FormCreate(Sender: TObject); // Create
begin
//
end;
procedure TForm1.List; // TextFile to array
var
MyFile : TextFile;
k : Integer;
begin
If FileExists('Dams.txt') <> True
then Application.Terminate;
AssignFile (MyFile, 'Dams.txt');
Reset(MyFile);
For K := 1 to 200 do
begin
Readln(MyFile, arrDams[k])
end;
end;
procedure TForm1.Search(sDam: String); // Search
begin
end;
procedure TForm1.Sort; // Sort;
var
K,L : byte;
sKeep : string;
begin
for k := 1 to iCount -1 do
begin
for l := k + 1 to iCount do
begin
if arrDams[k] > arrDams[L] then
begin
sKeep := arrDams[k];
arrDams[k] := arrDams[L];
arrDams[L] := sKeep
end;
end;
end;
end;
procedure TForm1.btnListClick(Sender: TObject);
begin
List;
Display;
end;
procedure TForm1.btnDisplayClick(Sender: TObject);
begin
display;
sort;
end; //<---------- ERROR OVER HERE!
end.
Theres 3 buttons at the top of the form, namely Show list, Make new textfile with list and Sort list alphabetically. The button Im working on is to sort the list. This question paper says I must make a sort procedure and must be called when the Sort Button is clicked.
Thanks for any advice/help
P.S.
Can you please point me to a link where they explain Selection Sorting in depth - the logic isn't with me on this..
You don't initialize iCount. So it is 0. Therefore iCount-1 is -1. However, you use Byte, an unsigned type, for your loop variable. Now, -1 when interpreted as an unsigned Byte is 255. If you follow this all through it means that you access the array out of bounds. In fact what happens is that the inner loop executes exactly once with a value of l equal to 0 and k equal to 255.
Were you to enable the range checking compiler option, you would have encountered a runtime error as soon as you run off the end of the array.
Presumably you want to initialize iCount to some value. I cannot tell what, but you will know.
Beyond that, stop using unsigned types for loop variables. Replace Byte with Integer.
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.
i have a problem on how to retrieve the items in memo from table into tchecklistbox...before this i do the procedure to insert the items that have been checked into memo in tbl POS_CatBreakDownValue..but now i want to know how to retrieve items from table and automatic check in tchecklistbox...thanks..here my procedure to insert the checklist into memo in table..i hope anyone can help me..thanks
procedure TfrmSysConfig.saveCatBreakDownValue;
var
lstCat:TStringList;
i :integer;
begin
lstcat := TStringList.Create;
try
for i:=0 to clCat.Items.Count-1 do begin
if clCat.Checked[i] then begin
lstcat.Add(clcat.Items.Strings[i]);
end;
end;
tblMainPOS_CatBreakDownValue.Value := lstCat.Text;
finally
lstcat.Free;
end;
end;
procedure TfrmSysConfig.saveCatBreakDownValue;
var
lstCat: TStringList;
i:integer;
begin
lstcat := TStringList.Create;
try
for i:=0 to clCat.Items.Count-1 do begin
if clCat.Checked[i] then begin
lstcat.Add(clcat.Items.Strings[i]);
end;
end;
tblMainPOS_CatBreakDownValue.Value := lstCat.Text;
finally
lstcat.Free;
end;
end;
Reading your code I'm guessing you've got a MemoField in a database that you are reading and writing the checked values from/to. You also have a predefined list of checkable items.
So you'll need to create a new string list and read the field back into it (Revesing the writing code). for each item in the list get the Index and check it.
Something like..
procedure TfrmSysConfig.saveCatBreakDownValue;
var
lstCat: TStringList;
i, Index:integer;
begin
lstcat := TStringList.Create;
try
lstcat.Text = tblMainPOS_CatBreakDownValue.Value;
for i:=0 to lstcat.Count-1 do
begin
Index := clCat.Items.IndexOf(lstcat.Items[i])
if Index > -1 then
begin
clCat.Checked[Index] := True;
end;
end;
finally
lstcat.Free;
end;
end;
Not sure I understand your question 100%
TCheckListBox can check or uncheck items using the Checked Property.
CheckListBox.Checked[Index] := True/False;
Since you sound like your comparing strings you may need to determine the index in the TCheckListBox based on the string this can be done like this:
CheckListBox1.Items.IndexOf('StringToFind')
If the string is not found then the result is -1;
If you want to check lines in a TMemo Control and see if they exists as rows in a table you can do the following.
While not Table.EOF do
begin
if Memo1.lines.IndexOf(Table.FieldByName('MyField').AsString) = -1 then
begin
// What you want to do if not found
end
else
begin
// what you want to do if it is found.
end;
Table.Next;
end;