I am currently making "noughts and crosses" as homework. I generated a 10x10 array of TButton objects, but I don't know how they are called and how to control them:
Form1: TForm1;
pole: array[1 .. 10, 1 .. 10] of TButton;
h:TButton;
for i:=1 to 10 do
for j:=1 to 10 do
begin
h:=TButton.Create(Self);
h.Parent:=Self;
h.Width:=50;
h.Height:=50;
h.Left:=((i+1)*50)-100;
h.top:=((j+1)*50)-100;
h.OnClick := hClick;
end;
Are my buttons even in that array? I must say I am confused a bit here.
You have to assign every newly created button object to appropriate array entry.
Another important thing - inside common event handler you probably want to determine what button is pressed. Possible way - use object field Tag
for i:=1 to 10 do
for j:=1 to 10 do begin
h:=TButton.Create(Self);
pole[i, j] := h;
...
h.OnClick := hClick;
h.Tag := 10 * i + j; //store both row and column
end;
procedure ...hClick(Sender: TObject);
var
i, j: integer;
begin
i := (Sender as TButton).Tag div 10; // extract row and column
j := (Sender as TButton).Tag mod 10;
...
end;
At the end of for-loop add
pole[i][j] := h;
Because every iteration you just overwrite variable 'h' and nothing gets added into array.
Related
///Example
some_array[0]:=0;
some_array[1]:=1;
some_array[2]:=2;
some_array[3]:=3;
some_array[4]:=4;
And now I need to shift values in array like this (by one cell up)
some_array[0]:=1;
some_array[1]:=2;
some_array[2]:=3;
some_array[3]:=4;
some_array[4]:=0;
Is there any build in procedure or I have to do this manually by copying to some temporary array?
There is no built in function for this. You will need to write your own. It might look like this:
procedure ShiftArrayLeft(var arr: array of Integer);
var
i: Integer;
tmp: Integer;
begin
if Length(arr) < 2 then
exit;
tmp := arr[0];
for i := 0 to high(arr) - 1 do
arr[i] := arr[i + 1];
arr[high(arr)] := tmp;
end;
Note that there is no need to copy to a temporary array. You only need to make a temporary copy of one element.
If your arrays are huge then the copying overhead could be significant. In which case you would be better off using a circular array. With a circular array you remember the index of the first element. Then the shift operation is just a simple increment or decrement operation on that index, modulo the length of the array.
If you use a modern Delphi then this could readily be converted to a generic method. And I think it should be easy enough for you to write the shift in the opposite direction.
There is no such procedure in the RTL.
A generic procedure (as proposed by #DavidHeffernan) might look something like this:
Type
TMyArray = record
class procedure RotateLeft<T>(var a: TArray<T>); static;
end;
class procedure TMyArray.RotateLeft<T>(var a: TArray<T>);
var
tmp : T;
i : Integer;
begin
if Length(a) > 1 then begin
tmp := a[0];
for i := 1 to High(a) do
a[i-1] := a[i];
a[High(a)] := tmp;
end;
end;
var
a: TArray<Integer>;
i:Integer;
begin
SetLength(a,5);
for i := 0 to High(a) do a[i] := i;
TMyArray.RotateLeft<Integer>(a);
for i := 0 to High(a) do WriteLn(a[i]);
ReadLn;
end.
A low level routine using Move() could be used if performance is critical:
class procedure TMyArray.RotateLeft<T>(var a: TArray<T>);
var
tmp : T;
begin
if Length(a) > 1 then begin
Move(a[0],tmp,SizeOf(T)); // Temporary store the first element
Move(a[1],a[0],High(a)*SizeOf(T));
Move(tmp,a[High(a)],SizeOf(T)); // Put first element last
// Clear tmp to avoid ref count drop when tmp goes out of scope
FillChar(tmp,SizeOf(T),#0);
end;
end;
Note the FillChar() call to clear the temporary variable at the end. If T is a managed type, it would otherwise drop the reference count of the last array element when going out of scope.
Stumbling across this one while facing a similar issue.
I have not implemented it yet, but have thought about this different approach: KEEP the array as it is, but make a new procedure to read values where you change the "zero" position.
Example:
read_array(index: integer; shift: integer)..
So if your original array is read with this function, using shift "1" it would read "1,2,3,4,0" (obviously looping). It would require you to keep track of a few things, but would not require modifying anything. So performance should be greater for very large arrays.
Similar would work for other types as well.
EDIT: an example function with free start index and variable step size plus sample size is here:
function get_shifted_array(inArray: TStringList; startindex,
lineCount: integer;
stepsize: integer): TStringList;
var
i : integer; // temp counter
nextindex : integer; // calculate where to get next value from...
arraypos : integer; // position in inarray to take
temp : tstringlist;
// function to mimic excel Remainder( A,B) function
// in this remainder(-2,10) = 8
//
function modPositive( dividend, divisor: integer): integer;
var
temp : integer;
begin
if dividend < 0 then
begin
temp := abs(dividend) mod divisor; // 1 mod 10 =9 for -1
// 122 mod 10 = 2 for -122
result := (divisor - temp);
end
else
result := dividend mod divisor;
end;
begin
nextindex := startindex; // where in input array to get info from
temp := tstringlist.create; // output placeholder
for i := 1 to lineCount do
begin
// convert to actual index inside loop
arraypos := modPositive(nextindex, inarray.count); // handle it like Excel: remainder(-1,10) = 9
// if mod is zero, we get array.count back. Need zero index then.
if arraypos = inArray.Count then arraypos := 0; // for negative loops.
// get the value at array position
temp.Add( 'IDX=' + inttostr(arraypos) + ' V=' + inarray[ arraypos ] );
// where to go next
// should we loop ?
if ((nextindex+ stepsize +1)> inArray.Count ) then
begin
nextindex := (nextindex + stepsize ) mod inArray.Count;
end
else
nextindex := nextindex + stepsize;
end;
result := temp;
end;
Thereby:
get_shifted_array(
inputarray,
-1, // shiftindex
length(inputarray),
1 ) // stepsize
would return the array shifted backwards one place.
All without any modification to array.
I have a form that has a TADVStringGrid. I am trying to add a combobox to some rows in a specific column (2); however, I can't get the data to show on the dropdown. I added the HasComboBox event, I set the DirectComboDrop, and it still did not show any data in the dropdown. They were just empty. I check the object that I am adding to the dropdown, and they had data. What am I missing here?
procedure UserForm.DisplayGrid(Sender: TObject);
var
J : Integer;
begin
... additional logic
...
if OutputList.Count > 2 then
begin
with UserGrid.Combobox do
begin
for J := 0 to OutputList.Count - 1 do
BEGIN
if not(OutputList[J] = '') then
begin
dValue := DropDownValue.Create;
dValue.ID := J + 1;
dvalue.Name := OutputList[J];
dvalue.TestValue := OutputList[J] + 'testvalue'; // where value will be a list to choose from
ListOfTest.Add(dValue); // this is a glabal variable where I for later reference
ItemIndex := dValue.ID;
end;
END;
end;
end;
//event
procedure UserForm.UserGridHasComboBox(Sender: TObject; ACol, ARow: Integer;
var HasComboBox: Boolean);
begin
HasComboBox := True;
end;
There is an event handle called EditorProp that needed to be added. Data that need to be added for a specific column have to be added when the EditorProp event is called. The piece of code below was moved into the editorprop event, and it's working fine since.
for J := 0 to OutputList.Count - 1 do
BEGIN
if not(OutputList[J] = '') then
begin
dValue := DropDownValue.Create;
dValue.ID := J + 1;
dvalue.Name := OutputList[J];
dvalue.TestValue := OutputList[J] + 'testvalue'; // where value will be a list to choose from
ListOfTest.Add(dValue); // this is a glabal variable where I for later reference
ItemIndex := dValue.ID;
end;
I want to make something like that. I have a list in my StringGrid and i want to delete one row by selecting cell and then clicking the button. Then this list should show again in StringGrid without this row. The biggest problem i have with deleting row, i tried whis one procedure but it only deleted row in StringGrid, not in list, i think.
procedure DeleteRow(Grid: TStringGrid; ARow: Integer);
var
i: Integer;
begin
for i := ARow to Grid.RowCount - 2 do
Grid.Rows[i].Assign(Grid.Rows[i + 1]);
Grid.RowCount := Grid.RowCount - 1;
end;
Please someone for help. :)
If you're using a standard VCL TStringGrid (without using the live bindings made available in recent versions), you can use an interposer class to access the protected TCustomGrid.DeleteRow method.
The following code has been tested in Delphi 2007. It uses a simple TStringGrid dropped on a form, with the default columns and cells, and a standard TButton.
The TForm.OnCreate event handler simply populates the grid with some data to make it easier to see the deleted row. The button click event deletes row 1 from the stringgrid every time it's clicked.
Note: The code does no error checking to make sure that there are enough rows. This is a demo application and not an example of production code. Your actual code should check the number of rows available before attempting to delete one.
// Interposer class, named to indicate it's use
type
THackGrid=class(TCustomGrid);
// Populates stringgrid with test data for clarity
procedure TForm1.FormCreate(Sender: TObject);
var
i, j: Integer;
begin
for i := 1 to StringGrid1.ColCount - 1 do
StringGrid1.Cells[i, 0] := Format('Col %d', [i]);
for j := 1 to StringGrid1.RowCount - 1 do
begin
StringGrid1.Cells[0, j] := Format('Row #d', [j]);
for i := 1 to StringGrid1.ColCount - 1 do
begin
StringGrid1.Cells[i, j] := Format('C: %d R: %d', [i, j]);
end;
end;
end;
// Deletes row 1 from the stringgrid every time it's clicked
// See note above for info about lack of error checking code.
procedure TForm1.Button1Click(Sender: TObject);
begin
THackGrid(StringGrid1).DeleteRow(1);
end;
If you're using a more recent version, and have attached the data to the grid using live bindings, you can just delete the row from the underlying data and let the live bindings handle removing the row.
The selected row can be retrieved StringGrid1.selected and the you can call the following procedure.
procedure TUtils.DeleteRow(ARowIndex: Integer; AGrid: TStringGrid);
var
i, j: Integer;
begin
with AGrid do
begin
if (ARowIndex = RowCount) then
RowCount := RowCount - 1
else
begin
for i := ARowIndex to RowCount do
for j := 0 to ColumnCount do
Cells[j, i] := Cells[j, i + 1];
RowCount := RowCount - 1;
end;
end;
end;
I have trouble keeping a TListbox in sync with a TList. Each time an item is added to a generic TList, OnNotify is called and the callback calls just one procedure: create_gradients. Its code is below:
procedure TColor_Dialog.create_gradients;
var Editor: TGradient_Editor;
eGradient: Int32;
y: single;
s: string;
begin
List_Names.Clear;
List_Gradients.Clear;
for eGradient := 0 to FColor_Editor.nGradients - 1 do
begin
List_Names.Items.Add (FColor_Editor [eGradient].Check_Rainbow.Text);
end; // for
List_Gradients.BeginUpdate;
try
for eGradient := 0 to FColor_Editor.nGradients - 1 do
begin
Editor := FColor_Editor [eGradient];
y := (eGradient + 1) * Editor.Height;
Editor.Position.Y := y;
s := Editor.Check_Rainbow.Text;
List_Gradients.AddObject (Editor);
end; // for
finally
List_Gradients.EndUpdate;
end; // try..finally
end; // create_gradients //
As you see it simply enumerates all items in the list. Each item in the list is a TGradient_Editor which in turn has TFrame as a parent. On the parent are some FMX controls as combolorboxes, an image and a checkbox (Check_Rainbow). Check_Rainbow.Text is used for identification purposes. When the gradient editor is created, it creates a unique name from frame_%s where %s is a sequence number that is incremented each time a gradient editor is created. Owner and Parent are both List_Gradients.
From the image above you can see what happens. the listbox on the right is added for checking and just shows the text's, which is the correct sequence by the way. When I use the debugger to follow the addition of the gradient editors to List_Gradient they are processed in the same order. But the order of the gradient editors is wrong. I have to mention that the aligment of the gradient editors is alTop. I added even some code to ensure that the editor is Positioned at the very bottom of the List_Gradients.
I appear not to understand something. I cannot imagine that sequential adding to a TListBox cannot result in the correct order. What am I doing wrong?
Try this instead:
procedure TColor_Dialog.create_gradients;
var
Editor: TGradient_Editor;
eGradient: Int32;
y: single;
begin
List_Names.Clear;
List_Gradients.Clear;
for eGradient := 0 to FColor_Editor.nGradients - 1 do
begin
List_Names.Items.Add (FColor_Editor[eGradient].Check_Rainbow.Text);
end;
List_Gradients.BeginUpdate;
try
y := 0.0; // or whatever value you want to start at...
for eGradient := 0 to FColor_Editor.nGradients - 1 do
begin
Editor := FColor_Editor[eGradient];
Editor.Position.Y := y;
List_Gradients.AddObject(Editor);
y := y + Editor.Height;
end;
finally
List_Gradients.EndUpdate;
end;
end;
As requested I moved the answer to this section. The correct code is:
procedure TColor_Dialog.create_gradients;
var Editor: TGradient_Editor;
eGradient: Int32;
y: single;
begin
List_Gradients.BeginUpdate;
try
List_Gradients.Clear;
y := 0;
for eGradient := 0 to FColor_Editor.nGradients - 1 do
begin
Editor := FColor_Editor [eGradient];
Editor.Position.X := 0;
Editor.Position.Y := y;
Editor.Width := List_Gradients.Width;
List_Gradients.AddObject (Editor);
y := y + Editor.Height;
end; // for
finally
List_Gradients.EndUpdate;
end; // try..finally
end; // create_gradients //
and not using any alignment anymore. Adding Objects to a TListBox is a real nice feature of FMX. However, be prepared that things sometimes work differently than you expect. For one thing: objects are not positioned in the same way as strings.
I have a need to keep the top ten values in sorted order. My data structure is:
TMyRecord = record
Number: Integer;
Value: Float;
end
I will be calculating a bunch of float values. I need to keep the top 10 float values. Each value has an associated number. I want to add "sets"... If my float Value is higher than one of the top 10, it should add itself to the list, and then the "old" number 10, now 11, gets discarded. I should be able to access the list in (float value) sorted order...
It is almost like a TStringList, which maintains sorted order....
Is there anything like this already built into Delphi 2010?
You can use a combination of the generic list Generics.Collections.TList<TMyRecord> and insertion sort.
Your data structure is like this
TMyRecord = record
Number: Integer;
Value: Float;
end;
var
Top10: TList<TMyRecord>;
You'll need to use Generics.Collections to get the generic list.
Instantiate it like this:
Top10 := TList<TMyRecord>.Create;
Use this function to add to the list:
procedure Add(const Item: TMyRecord);
var
i: Integer;
begin
for i := 0 to Top10.Count-1 do
if Item.Value>Top10[i].Value then
begin
Top10.Insert(i, Item);
Top10.Count := Min(10, Top10.Count);
exit;
end;
if Top10.Count<10 then
Top10.Add(Item);
end;
This is a simple implementation of insertion sort. The key to making this algorithm work is to make sure the list is always ordered.
David's answer is great, but I think as you progress through the data, you'll fill the list pretty fast, and the odds of having a value greater than what's already in the list probably decreases over time.
So, for performance, I think you could add this line before the for loop to quickly discard values that don't make it into the top 10:
if (Item.Value <= Top10[Top10.Count - 1].Value) and (Top10.Count = 10) then
Exit;
If the floats are always going to be above a certain threshold, it might make sense to initialize the array with 10 place-holding records with values below the threshold just so you could change the first line to this:
if (Item.Value <= Top10[9].Value) then
Exit;
And improve the method to this:
procedure Add(const Item: TMyRecord);
var
i: Integer;
begin
// Throw it out if it's not bigger than our smallest top10
if (Item.Value <= Top10[9].Value) then
Exit;
// Start at the bottom, since it's more likely
for i := 9 downto 1 do
if Item.Value <= Top10[i - 1].Value then
begin
// We found our spot
Top10.Insert(i, Item);
// We're always setting it to 10 now
Top10.Count := 10;
// We're done
Exit;
end;
// Welcome, leader!
Top10.Insert(0, Item);
// We're always setting it to 10 now
Top10.Count := 10;
end;
Since you are working with a fixed number of items, you could use a plain TMyRecord array, eg:
type
TMyRecord = record
Number: Integer;
Value: Float;
end;
const
MaxRecordsInTopTen = 10;
var
TopTen: array[0..MaxRecordsInTopTen-1] of TMyRecord;
NumRecordsInTopTen: Integer = 0;
procedure CheckValueForTopTen(Value: Float; Number: Integer);
var
I, J, NumToMove: Integer;
begin
// see if the new Value is higher than an value already in the list
for I := 0 to (NumRecordsInTopTen-1) do
begin
if Value > TopTen[I].Value then
begin
// new Value is higher then this value, insert before
// it, moving the following values down a slot, and
// discarding the last value if the list is full
if NumRecordsInTopTen < MaxRecordsInTopTen then
NumToMove := NumRecordsInTopTen - I
else
NumToMove := MaxRecordsInTopTen - I - 1;
for J := 1 to NumToMove do
Move(TopTen[NumRecordsInTopTen-J], TopTen[NumRecordsInTopTen-J-1], SizeOf(TMyRecord));
// insert the new value now
TopTen[I].Number := Number;
TopTen[I].Value := Value;
NumRecordsInTopTen := Min(NumRecordsInTopTen+1, MaxRecordsInTopTen);
// all done
Exit;
end;
end;
// new value is lower then existing values,
// insert at the end of the list if room
if NumRecordsInTopTen < MaxRecordsInTopTen then
begin
TopTen[NumRecordsInTopTen].Number := Number;
TopTen[NumRecordsInTopTen].Value := Value;
Inc(NumRecordsInTopTen);
end;
end;
I wouldn't bother with anything other than straight Object Pascal.
{$APPTYPE CONSOLE}
program test2; uses sysutils, windows;
const
MAX_VALUE = $7FFF;
RANDNUMCOUNT = 1000;
var
topten: array[1..10] of Longint;
i, j: integer;
Value: Longint;
begin
randomize;
FillChar(topten, Sizeof(topten), 0);
for i := 1 to RANDNUMCOUNT do
begin
Value := Random(MAX_VALUE);
j := 1;
while j <= 10 do
begin
if Value > topten[j] then
begin
Move(topten[j], topten[j+1], SizeOf(Longint) * (10-j));
topten[j] := Value;
break;
end;
inc(j);
end;
end;
writeln('Top ten numbers generated were: ');
for j := 1 to 10 do
writeln(j:2, ': ', topten[j]);
readln;
end.