Is there a way to switch components mid-loop? - loops

I am trying to animate a dropdown menu of 7 images using a for loop, using a different component to change after each iteration of the code inside the for loop. For example, the first time the loop runs: imgCourses7.Top is used, but the second time the loop runs (when I = 1) then imgCourses6.Top should be used instead.
iCoursesCount := 7;
iTotalLength := (6+41)*iCoursesCount;
imgCourses7.Top := 6;
imgCourses6.Top := 6;
imgCourses5.Top := 6;
imgCourses4.Top := 6;
imgCourses3.Top := 6;
imgCourses2.Top := 6;
imgCourses1.Top := 6;
for I := 0 to iCoursesCount -1 do
begin
while not(imgCourses7.Top = iTotalLength - 41*(I+1)) do
begin
imgCourses8.Top := imgCourses8.Top + 6;
sleep(8);
application.ProcessMessages;
if imgCourses7.Top >= iTotalLength - 41*(I+1) then
begin
imgCourses7.Top := iTotalLength - 41*(I+1);
break;
end;
end;
end;

Like #AndreasRejbrand said in a comment, you can use an array, eg:
var
Images: array[0..6] of TImage;
TargetTop: Integer;
...
...
Images[0] := imgCourses7;
Images[1] := imgCourses6;
Images[2] := imgCourses5;
Images[3] := imgCourses4;
Images[4] := imgCourses3;
Images[5] := imgCourses2;
Images[6] := imgCourses1;
iCoursesCount := Length(Images);
TargetTop := 6+(41*iCoursesCount);
for I := 0 to iCoursesCount-1 do begin
Images[I].Top := 6;
end;
for I := 0 to iCoursesCount-1 do
begin
Dec(TargetTop, 41);
while Images[I].Top <> TargetTop do
begin
Images[I].Top := Images[I].Top + 6;
Sleep(8);
Application.ProcessMessages;
if Images[I].Top >= TargetTop then
begin
Images[I].Top := TargetTop;
Break;
end;
end;
end;
That being said, you really shouldn't be using a sleeping loop that requires Application.ProcessMessages() on each iteration. You might consider using a TTimer or TThread.ForceQueue() instead. Don't block the main UI thread unnecessarily. For example:
published
procedure FormCreate(Sender: TObject);
private
Images: array[0..6] of TImage;
TargetTop: Integer;
CurrentImage: Integer;
procedure StartAnimatingMenu;
procedure StartAnimatingNextMenuItem;
procedure StepAnimateCurrentMenuItem;
...
...
procedure TMyForm.FormCreate(Sender: TObject);
begin
Images[0] := imgCourses7;
Images[1] := imgCourses6;
Images[2] := imgCourses5;
Images[3] := imgCourses4;
Images[4] := imgCourses3;
Images[5] := imgCourses2;
Images[6] := imgCourses1;
end;
procedure TMyForm.StartAnimatingMenu;
var
I: Integer;
begin
for I := Low(Images) to High(Images) do begin
Images[I].Top := 6;
end;
TargetTop := 6+(41*Length(Images));
CurrentImage := -1;
StartAnimatingNextMenuItem;
end;
procedure TMyForm.StartAnimatingNextMenuItem;
begin
Inc(CurrentImage);
if CurrentImage < Length(Images) then
begin
Dec(TargetTop, 41);
StepAnimateCurrentMenuItem;
end;
end;
procedure TMyForm.StepAnimateCurrentMenuItem;
begin
if Images[CurrentImage].Top <> TargetTop then
begin
Images[CurrentImage].Top := Images[CurrentImage].Top + 6;
TThread.ForceQueue(nil, StepAnimateCurrentMenuItem, 8);
end
else if Images[CurrentImage].Top >= TargetTop then
begin
Images[CurrentImage].Top := TargetTop;
StartAnimatingNextMenuItem;
end;
end;

Related

Delphi - reading the records of a database into a string grid

So how do you write the records of a database (from a TADOTable component) into a String grid? (the record's fields are all strings)
I tried something like this but to no avail:
procedure TfrmPuntehou.WriteToList(tbl: TADOTable;grid:TStringGrid);
var
iNewRowCount:integer;
i,j,m: Integer;
const
separator = ',';
begin
tempList:= TStringList.Create;
try
tbl.First;
while not (tbl.Eof) do
begin
tempList.Add(tbl['Car Number']+separator+tbl['Racer Name']+separator+tbl['Licence']);
tbl.Next;
end;
for j:= 1 to (tempList.Count - 1) do
begin
grid.Rows[j].Text := tempList.Strings[(J-1)] ;
end;
finally
tempList.Free;
end;
//fill the row numbers
for m := 1 to grid.rowcount do
begin
grid.Cells[0,m]:= IntToStr(m);
end;
end;
Example of the output I'm trying to get on startup: (Row number column is not part of the db)
Thanks in advance for the help!
Kind Regards
PrimeBeat
You're going through far too much work. You don't need the separate stringlist at all, and your code could be much simpler.
var
i, Row: Integer;
begin
// Populate header row
Grid.Cells[0, 0] := 'Row';
Row := 0;
for i := 0 to Tbl.FieldCount - 1 do
Grid.Cells[i + 1, Row] := Tbl.Fields[i].FieldName; // The +1 skips the Row column
Inc(Row);
// Populate cells
Tbl.First;
while not Tbl.Eof do
begin
for i := 0 to Tbl.FieldCount - 1 do
begin
Grid.Cells[i, Row] := IntToStr(i); // Populate Row number
Grid.Cells[i + 1, Row] := Tbl.Fields[i].AsString; // Fill rest of row with table data
end;
Inc(Row);
Tbl.Next;
end;
end;
Here is an example using TADOQuery and a StringGrid:
procedure TForm1.Button1Click(Sender: TObject);
var
I : Integer;
ARow : Integer;
begin
ADOConnection1.Open('user', 'pass');
ADOQuery1.SQL.Text := 'SELECT * FROM dbo.Person';
ADOQuery1.Open;
if ADOQuery1.Eof then begin
ShowMessage('Data not found');
Exit;
end;
SGrid.RowCount := 1;
SGrid.ColCount := ADOQuery1.Fields.Count + 1;
// Create titles of row 0
for I := 0 to ADOQuery1.Fields.Count - 1 do
SGrid.Cells[I + 1, 0] := ADOQuery1.Fields[I].DisplayName;
// Populate the cells with data from result set
ARow := 1;
while not ADOQuery1.Eof do begin
Inc(ARow);
SGrid.RowCount := ARow + 1;
SGrid.Cells[0, ARow] := ARow.ToString;
for I := 0 to ADOQuery1.Fields.Count - 1 do
SGrid.Cells[I + 1, ARow] := ADOQuery1.Fields[I].AsString;
ADOQuery1.Next;
end;
end;
Thanks to Ken White's answer, I managed to solve the problem!
procedure TfrmPuntehou.WriteToList(tbl: TADOTable;grid:TStringGrid);
var
Row: Integer;
begin
tbl.Active:=True;
Row := 1;
// Populate cells
Tbl.First;
while not Tbl.Eof do
begin
grid.Cells[0,Row]:= IntToStr(Row);
grid.Cells[1,Row]:= tbl.fields[0].AsString;
grid.Cells[2,Row]:= tbl.fields[1].AsString;
grid.Cells[3,Row]:= tbl.fields[2].AsString;
Inc(Row);
IncreaseRowCount(grid);
Tbl.Next;
end;
tbl.Active:=false;
end;

How to delete a similar number in the second panel when clicking on a button from the first panel?

I have such a task, there is a group of buttons with numbers, in the first panel and five numbers are randomly selected in the second panel. How, when clicking on a button from the first panel, delete similar numbers in the second panel (this number should also be deleted from the first panel) and then random replace the deleted button in the second panel so that the deleted numbers never again repeat. How to do it?
An example of a picture.
My code is:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
procedure FormCreate(Sender: TObject);
procedure butClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
arr1: Array[1..20] of Integer;
but:array[1..9] of TButton;
but1:array[1..9] of TButton;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
i,x,k,tmp,N: integer;
A: array of integer;
begin
randomize();
arr1[1] := 34;
arr1[2] := 15;
arr1[3] := 79;
arr1[4] := 17;
arr1[5] := 91;
arr1[6] := 32;
arr1[7] := 11;
arr1[8] := 15;
arr1[9] := 12;
arr1[10] := 18;
arr1[11] := 21;
arr1[12] := 37;
arr1[13] := 75;
arr1[14] := 51;
arr1[15] := 30;
arr1[16] := 24;
arr1[17] := 94;
arr1[18] := 52;
arr1[19] := 43;
arr1[20] := 28;
N:=Length(arr1)-1;
setlength(A,Length(arr1));
Memo1.Clear;
for k := 1 to N do A[k] := arr1[k];
for k := 1 to N do begin
x := random(Length(arr1));
tmp := A[k];
A[k] :=A[x];
A[x] := tmp;
end;
for i := 1 to 5 do
begin
but1[i] := TButton.Create(Form1);
but1[i].Parent := Form1;
but1[i].Caption := IntToStr(A[i]);
but1[i].Font.Size := 26;
but1[i].Width := 50;
but1[i].Height := 50;
but1[i].Left := 300 + i * 50;
but1[i].Top := 50;
end;
for i := 1 to Length(arr1) do
begin
but[i] := TButton.Create(Form1);
but[i].Parent := Form1;
but[i].Caption := IntToStr(arr1[i]);
but[i].Font.Size := 26;
but[i].Width := 50;
but[i].Height := 50;
but[i].Tag := arr1[i];
but[i].Left := 50 + Round(i mod 3)*but[i].Width;
but[i].Top := 50 + Round(i / 3)*but[i].Height;
but[i].OnClick := butClick;
end;
end;
procedure TForm1.butClick(Sender: TObject);
begin
ShowMessage(IntToStr((Sender as TButton).Tag));
end;
end.
I changed your butClick Procedure and it worked fine in my tests. Give it a try:
procedure TForm1.butClick(Sender: TObject);
var
btn_tag, i: Integer;
n1Control, n2Control: TControl;
begin
btn_tag := (Sender as TButton).Tag;
ShowMessage(IntToStr(btn_tag));
n1Control := Sender as TButton;
n2Control := Nil;
for i := 0 to Form1.ControlCount - 1 do
if Form1.Controls[i] is TButton then
if ((Form1.Controls[i] as TButton).Caption = IntToStr(btn_tag)) and (Form1.Controls[i].Tag = 0) Then
n2Control := Form1.Controls[i];
if n2Control <> Nil then Begin
FreeAndNil(n1Control);
FreeAndNil(n2Control);
End;
end;
In a button's onclick event handler, you would want to:
Determine the number (tag or caption) that was clicked
Search through the controls on Panel2 to find a match
If found, delete both controls then
Select a random number of the remaining controls on Panel1
Use the random index to clone a new button on Panel2
In your code above, you should be setting the Parent of each button object to one of the two GroupBoxes. This will put the buttons in the Controls list of each groupbox, e.g. GroupBox1.ControlCount or GroupBox1.Controls[0] . You are not setting the Tag property for the 5 buttons in the second group, which means you'll have to use the Caption to find a match. Also, arrays in Delphi are zero-based. You should adjust your code accordingly.

How to align 2 arrays without temporary arrays?

I have 2 arrays that I need to align lines. I prepare the 'control' array which has the info on how to align arrays and then I do it, with help of temp arrays.
See in picture the arrays and result as aligned arrays:
Here is the code that I use, as MCVE:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
System.Math,
System.Generics.Defaults,
System.Generics.Collections;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TSide = (sLeft, sRight, sBoth);
TData = record
DataID: integer;
DataName: string;
BlankLine: boolean;
end;
TCtrlData = record
Side: TSide;
Idx_l: integer;
Idx_r: integer;
end;
var
Form1: TForm1;
aLeft, aRight, aLeft_tmp, aRight_tmp: TArray<TData>; // main and temp arrays
aCtrl: TArray<TCtrlData>; // control array with instructions o nhow to align lines
implementation
{$R *.dfm}
procedure PrepareData;
begin
// prepare data
SetLength(aLeft, 4);
aLeft[0].DataID := 1; aLeft[0].DataName := 'One';
aLeft[1].DataID := 2; aLeft[1].DataName := 'Three';
aLeft[2].DataID := 3; aLeft[2].DataName := 'Six';
aLeft[3].DataID := 4; aLeft[3].DataName := 'Eight';
SetLength(aRight, 6);
aRight[0].DataID := 1; aRight[0].DataName := 'One';
aRight[1].DataID := 2; aRight[1].DataName := 'Two';
aRight[2].DataID := 3; aRight[2].DataName := 'Four';
aRight[3].DataID := 4; aRight[3].DataName := 'Five';
aRight[4].DataID := 5; aRight[4].DataName := 'Seven';
aRight[5].DataID := 6; aRight[5].DataName := 'Eight';
// do the magic - prepare control array
SetLength(aCtrl, 8);
aCtrl[0].Side := sBoth; aCtrl[0].Idx_L := 0; aCtrl[0].Idx_R := 0;
aCtrl[1].Side := sRight; aCtrl[1].Idx_R := 1;
aCtrl[2].Side := sLeft; aCtrl[2].Idx_L := 1;
aCtrl[3].Side := sRight; aCtrl[3].Idx_R := 2;
aCtrl[4].Side := sRight; aCtrl[4].Idx_R := 3;
aCtrl[5].Side := sLeft; aCtrl[5].Idx_L := 2;
aCtrl[6].Side := sRight; aCtrl[6].Idx_R := 4;
aCtrl[7].Side := sBoth; aCtrl[7].Idx_L := 3; aCtrl[7].Idx_R := 5;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i, vIndex: integer;
begin
PrepareData;
{ prepare arrays based on Control array
Loop through Control array and fill temp arrays from Left or Right arrays }
SetLength(aLeft_tmp, 0);
SetLength(aRight_tmp, 0);
SetLength(aLeft_tmp, Length(aCtrl));
SetLength(aRight_tmp, Length(aCtrl));
vIndex := 0;
for i := 0 to High(aCtrl) do
begin
if aCtrl[i].Side = sBoth then // Data from Both
begin
aLeft_tmp[vIndex] := aLeft[aCtrl[i].Idx_L];
aRight_tmp[vIndex] := aRight[aCtrl[i].Idx_R];
Inc(vIndex);
end;
if aCtrl[i].Side = sLeft then // Data from Left side
begin
aLeft_tmp[vIndex] := aLeft[aCtrl[i].Idx_L];
aRight_tmp[vIndex].BlankLine := true;
Inc(vIndex);
end;
if aCtrl[i].Side = sRight then // Data from Right side
begin
aRight_tmp[vIndex] := aRight[aCtrl[i].Idx_R];
aLeft_tmp[vIndex].BlankLine := true;
Inc(vIndex);
end;
end;
// Assign aligned data to main arrays
aLeft := aLeft_tmp;
aRight := aRight_tmp;
end;
As I use the same or similar code for a lot of arrays, I'm trying to refactor and simplify it with AlignArrays function:
procedure AlignArrays(vCtrl: TArray<TCtrlData>; var vLeft, vRight: TArray<TData>);
var
i, vIndex: integer;
vLeft_tmp, vRight_tmp: TArray<TData>;
begin
SetLength(vLeft_tmp, Length(vCtrl));
SetLength(vRight_tmp, Length(vCtrl));
vIndex := 0;
{ prepare arrays based on Control array
Loop through Control array and fill temp arrays from Left or Right arrays }
for i := 0 to High(vCtrl) do
begin
if vCtrl[i].Side = sBoth then // Data from Both
begin
vLeft_tmp[vIndex] := vLeft[vCtrl[i].Idx_L];
vRight_tmp[vIndex] := vRight[vCtrl[i].Idx_R];
Inc(vIndex);
end;
if vCtrl[i].Side = sLeft then // Data from Left side
begin
vLeft_tmp[vIndex] := vLeft[vCtrl[i].Idx_L];
vRight_tmp[vIndex].BlankLine := true;
Inc(vIndex);
end;
if vCtrl[i].Side = sRight then // Data from Right side
begin
vRight_tmp[vIndex] := vRight[vCtrl[i].Idx_R];
vLeft_tmp[vIndex].BlankLine := true;
Inc(vIndex);
end;
end;
vLeft := vLeft_tmp;
vRight := vRight_tmp;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
i, vIndex: integer;
begin
PrepareData;
AlignArrays(aCtrl, aLeft, aRight);
end;
Question: Can this be better refactored and is it possible to work on the arrays without temp arrays?
EDIT:
From comments and answers it seems I waste too much time preparing MCVE, I should better explain the problem I have. But, from an CleoR's answer I got an idea to align arrays by starting in he last line and aligning to the top. Adn it seems to work, and here is why:
Because control array has instructions on how to align lines, I know exactly what the size of arrays is. And since aligning means 'stretchin' array/inserting new blank lines where needed, if I start from the bottom up, I don't need to insert anything, only move the lines that need to be moved.
Simple and it works - without temp arrays:
procedure AlignArraysBackwards(vCtrl: TArray<TCtrlData>; var vLeft, vRight: TArray<TData>);
var
i: integer;
vBlankRecord:TData;
begin
// set blank record to blank out the moved line
vBlankRecord.DataID:=0;
vBlankRecord.DataName:='';
vBlankRecord.BlankLine:=True;
// set lenght for arrays
SetLength(vLeft, Length(vCtrl));
SetLength(vRight, Length(vCtrl));
// align - starting from the bottom up
for i := High(vCtrl) downto 0 do
begin
if vCtrl[i].Side = sBoth then // Data from Both
begin
// move Left line
vLeft[i] := vLeft[vCtrl[i].Idx_L];
// blank out the line we just moved
if vCtrl[i].Idx_L<>i then vLeft[vCtrl[i].Idx_L]:=vBlankRecord;
// move Rigth line
vRight[i] := vRight[vCtrl[i].Idx_R];
// blank out the line we copied from
if vCtrl[i].Idx_R<>i then vRight[vCtrl[i].Idx_R]:=vBlankRecord;
end;
if vCtrl[i].Side = sLeft then // Data from Left side
begin
// move Left line
vLeft[i] := vLeft[vCtrl[i].Idx_L];
// blank out the line we just moved
if vCtrl[i].Idx_L<>i then vLeft[vCtrl[i].Idx_L]:=vBlankRecord;
// blank Right line
vRight[i].BlankLine := true;
end;
if vCtrl[i].Side = sRight then // Data from Right side
begin
// move Left line
vRight[i] := vRight[vCtrl[i].Idx_R];
// blank out the line we just moved
if vCtrl[i].Idx_R<>i then vRight[vCtrl[i].Idx_R]:=vBlankRecord;
// blank Left line
vLeft[i].BlankLine := true;
end;
end;
end;
UPDATE: Changed the solution to pseudocode.
You don't need a temp array, you can do it in place.
Lets assume the left and right arrays have enough space and they are the same size.
For each array you'll need to keep track of the last element in the array. Lets call this the dataPointer. Reverse loop over the arrays with a counter called endPointer.
At each step in the loop check if array[dataPointer] == endPointer + minElement for both arrays.
If true, array[endPointer] = endPointer + minElement and decrement the dataPointer.
If false, array[endPointer] = skip_value.
Do this until endPointer goes past the beginning of the array.
skip_value = 0
//Handles our assumptions.
function setup(left,right)
left.sort()
right.sort()
ldPointer = len(left)-1
rdPointer = len(right)-1
maxElement = max(left[ldPointer],right[rdPointer])
//This is 1 in your examples. You can hard code this number.
minElement = min(left[0],right[0])
padLength = maxElement - minElement + 1
pad(left,padLength)
pad(right,padLength)
return ldPointer,rdPointer,minElement
//Aligns the arrays.
function align(left,right)
ldPointer,rdPointer,minElement = setup(left,right)
for endPointer = len(left)-1; endPointer >= 0; i--
//Look at the left element.
if left[ldPointer] == endPointer+minElement
left[endPointer] = endPointer+minElement
ldPointer = ldPointer - 1
else
left[endPointer] = skip_value
//Look at the right element.
if right[rdPointer] == endPointer+minElement
right[endPointer] = endPointer+minElement
rdPointer = rdPointer - 1
else
right[endPointer] = skip_value
In case you want to try the algorithm out for yourself, heres a link to the repo. https://github.com/cleor41/StackOverflow_AlignArrays.
I don't know an ounce of Delphi but I tried to write it in Delphi so maybe you can understand it better. I also don't understand the need to have the control array.
procedure AlignArraysBackwards(var vLeft, vRight: TArray<TData>);
var
endPointer: Integer;
vBlankRecord: TData;
// Assumes the arrays have at least 1 element
ldPointer: Length(vLeft)-1;
rdPointer: Length(vRight)-1;
maxElement: Max(vLeft[ldPointer].DataID,vRight[rdPointer].DataID);
// Set this to 1 if arrays should always be 1 alligned
// Else it aligns arrays starting from the array with the smallest value.
minElement: Min(vLeft[0].DataID,vRight[0].DataID);
padLength: maxElement - minElement + 1;
begin
// set blank record to blank out the moved line
vBlankRecord.DataID:=0;
vBlankRecord.DataName:='';
vBlankRecord.BlankLine:=True;
// set length for arrays
SetLength(vLeft, padLength);
SetLength(vRight, padLength);
// align - starting from the bottom up
for endPointer := High(vLeft) downto 0 do
begin
// Start Left array
if vLeft[ldPointer].DataID = endPointer + minElement
then
begin
vLeft[endPointer] := vLeft[ldPointer];
ldPointer := ldPointer - 1;
end
else
begin
vLeft[endPointer] := vBlankRecord;
end;
// End Left Array
// Start Right array
if vRight[rdPointer].DataID = endPointer + minElement
then
begin
vRight[endPointer] := vRight[rdPointer];
rdPointer := rdPointer - 1;
end
else
begin
vRight[endPointer] := vBlankRecord;
end;
// End Right Array
end;
end;
You can make a method that will insert the records in the array or (as in my sample) you can use generics (TList).
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
Generics.Collections;
type
TData = record
DataID: integer;
DataName: string;
BlankLine: boolean;
// I add this function to make it make the code easier to read
class function New(const DataID: integer; DataName: string;
BlankLine: boolean = false): TData; static;
end;
var
aLeft, aRight: TList<TData>;
{ TData }
class function TData.New(const DataID: integer; DataName: string;
BlankLine: boolean = false): TData;
begin
result.DataID := DataID;
result.DataName := DataName;
result.BlankLine := BlankLine;
end;
procedure AllignData;
var
n: word;
begin
n := 0;
repeat
if (n < aRight.Count) and (n < aLeft.Count) then
begin
if aLeft[n].DataID < aRight[n].DataID then
aRight.Insert(n, TData.New(aLeft[n].DataID, '', true))
else if aLeft[n].DataID > aRight[n].DataID then
aLeft.Insert(n, TData.New(aRight[n].DataID, '', true));
// if they are equlal, we skip the line
// you wish to use an array instead, write a function inserting data item in it
end
else
begin
if n < aLeft.Count then
aRight.Add(TData.New(aRight[n].DataID, '', true));
if n < aRight.Count then
aLeft.Add(TData.New(aRight[n].DataID, '', true));
end;
inc(n);
until (n >= aRight.Count) and (n >= aLeft.Count);
end;
procedure OutputData;
var
n: word;
sl, sr: string;
begin
n := 0;
repeat
if n < aLeft.Count then
sl := aLeft[n].DataName
else
sl := '';
if n < aRight.Count then
sr := aRight[n].DataName
else
sr := '';
writeln(sl: 15, sr: 15);
inc(n);
until (n >= aRight.Count) and (n >= aLeft.Count);
end;
begin
// Initialize the data
aLeft := TList<TData>.Create;
aRight := TList<TData>.Create;
try
aLeft.Add(TData.New(1, 'One'));
aLeft.Add(TData.New(3, 'Three'));
aLeft.Add(TData.New(6, 'Six'));
aLeft.Add(TData.New(8, 'Eight'));
aRight.Add(TData.New(1, 'One'));
aRight.Add(TData.New(2, 'Two'));
aRight.Add(TData.New(4, 'Four'));
aRight.Add(TData.New(5, 'Five'));
aRight.Add(TData.New(7, 'Seven'));
aRight.Add(TData.New(8, 'Eight'));
aRight.Add(TData.New(9, 'Nine'));
aRight.Add(TData.New(10, 'Ten'));
// Do the output and processing
OutputData;
// I assume that the arrays (lists) have been sorted
AllignData;
writeln;
OutputData
finally
aLeft.Free;
aRight.Free;
end;
readln;
end.

How to send files from two different location with one TCP-Server?

How to send files from two different locations via only one TCP-Server, I managed to send files from one location only.
This the code to send from one directory ...
procedure TForm1.Timer1Timer(Sender: TObject);
var
fs: TFileStream;
fn: string;
sr: TSearchRec;
I: integer;
begin
I := 0;
if FindFirst('C:/*.jpg', faAnyFile, sr) = 0 then
begin
with StringGrid1 do
begin
ListBox1.Items.Add('C:/' + sr.Name);
while FindNext(sr) = 0 do
begin
ListBox1.Items.Add('C:/' + sr.Name);
Inc(I);
if I = 7 then
Break;
end;
FindClose(sr);
idTCPClient1.Connect;
for fn in ListBox1.Items do
begin
fs := TFileStream.Create(fn, fmOpenRead or fmShareDenyWrite);
try
idTCPClient1.IOHandler.WriteLn(ExtractFileName(fn));
idTCPClient1.IOHandler.Write(fs, 0, True);
idUDPClient1.Send(lbLatitude.Text + ',' + lbLongitude.Text);
Finally
fs.Free;
end;
end;
end;
end;
end;
All you have to do (without completely re-writing your code, like DavidH suggested) is simply fill your ListBox with paths from all of the different directories that you want, eg:
procedure TForm1.Timer1Timer(Sender: TObject);
var
fs: TFileStream;
fn: string;
sr: TSearchRec;
I : integer;
begin
I := 0;
if FindFirst('C:/*.jpg', faAnyFile, sr) = 0 then
begin
repeat
ListBox1.Items.Add('C:/' + sr.Name);
Inc(I);
if I = 7 then Break;
until FindNext(sr) <> 0;
FindClose(sr);
end;
if I < 7 then
begin
if FindFirst('C:/Some Other Folder/*.jpg', faAnyFile, sr) = 0 then
begin
repeat
ListBox1.Items.Add('C:/Some Other Folder/' + sr.Name);
Inc(I);
if I = 7 then Break;
until FindNext(sr) <> 0;
FindClose(sr);
end;
end;
idTCPClient1.Connect;
for fn in ListBox1.Items do
begin
fs := TFileStream.Create(fn, fmOpenRead or fmShareDenyWrite);
try
IdTCPClient1.IOHandler.WriteLn(ExtractFileName(fn));
IdTCPClient1.IOHandler.Write(fs, 0, True);
...
finally
fs.Free;
end;
end;
end;

Array Implementation in Delphi xe6

I want to fill the last three Edit's with the elements of r. Somehow the value of i is not changing. Please have a look!
procedure TForm1.Button1Click(Sender: TObject);
var
r: Array of Real;
cod,h,N,code,i: Integer;
value: Real;
begin
Val(Edit1.Text, cod, code);
Val(Edit2.Text, h, code);
Val(Edit3.Text, N, code);
Edit1.Text := Edit1.Text;
Edit2.Text := Edit2.Text;
Edit3.Text := Edit3.Text;
setlength(r, N);
i:= 0;
while i<= N do
begin
r[i] := cod/2 + h*i;
i := i + 1;
end;
Edit4.Text := formatfloat('#.0', r[0]);
Edit5.Text := formatfloat('#.0', r[1]);
Edit6.Text := formatfloat('#.0', r[2]);
end;
end.
Your code contains a lot of useless and buggy code. So I will fix it as far I can do from the given informations. I added a prefix L to all local variables
procedure TForm1.Button1Click(Sender: TObject);
var
Lr : Array[0..2] of Real;
Lcod, Lh : Integer;
LIdx : Integer;
begin
// throws an exception if Edit1.Text cannot converted to an Integer
Lcod := StrToInt( Edit1.Text );
// throws an exception if Edit2.Text cannot converted to an Integer
Lh := StrToInt( Edit2.Text );
for LIdx := 0 to 2 do
Lr[LIdx] := Lcod/2 + Lh*LIdx;
Edit4.Text := FormatFloat( '#.0', Lr[0] );
Edit5.Text := FormatFloat( '#.0', Lr[1] );
Edit6.Text := FormatFloat( '#.0', Lr[2] );
end;

Resources