Delphi sorting String grid - delphi

in matrix(StringGrid) NxM sort the elements of each row in nondecreasing order?
var
Form1: TForm1;
n,m:integer;
I:integer;
implementation
{$R *.dfm}
procedure TForm1.btNapraviClick(Sender: TObject);
begin
with StringGrid1 do
begin
n:=StrToInt(edN.text)+1;
m:=StrToInt(edM.text)+1;
ColCount:=n;
RowCount:=m;
for I:=0 to n-1 do Cells[I,0]:=IntToStr(I);
for I:=1 to m-1 do Cells[0,I]:=IntToStr(I);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var J,P,K:integer;
begin
with StringGrid1 do
begin
for I:=1 to n do
for J:=1 to m-1 do
for K:=J+1 to m do
begin
if StrToInt(Cells[I,J]) <= StrToInt(Cells[I,K]) then
begin
P:=StrToInt(Cells[I,J]);
Cells[I,J]:=(Cells[I,K]);
Cells[I,K]:=IntToStr(P);
end;
end;
end;
end;

Each Row in a StringGrid decends from TStrings, so you can assign a row to a TStringList and do a custom sort on that one.
Here is some source code:
First I fill the grid with Random data:
procedure TForm60.FormCreate(Sender: TObject);
var
i, j: Integer;
begin
Randomize;
with StringGrid1 do
begin
ColCount := 10;
RowCount := 10;
for i := 0 to ColCount - 1 do
for j := 0 to RowCount - 1 do
Cells[i, j] := IntToStr(Random(5000));
end;
end;
Then at Button1.Click I sort each row in descending order:
function StringListSortCompare(List: TStringList; Index1, Index2: Integer): Integer;
begin
Result := StrToIntDef(List[Index2], 0) - StrToIntDef(List[Index1], 0)
end;
procedure TForm60.Button1Click(Sender: TObject);
var
i: Integer;
Buffer: TStringList;
begin
Buffer := TStringList.Create;
for i := 0 to StringGrid1.RowCount - 1 do
begin
Buffer.Assign(StringGrid1.Rows[i]);
Buffer.CustomSort(#StringListSortCompare);
StringGrid1.Rows[i].Assign(Buffer);
end;
FreeAndNil(Buffer);
end;
Since I subStract the integer value of List[Index2] from List[Index1] the list becomes sorted descending.
And the result:
Before
After
After reading your question again I'm not sure if you by "nondecreasing order" mean increasing order. If so just implement the sort procedure like this:
function StringListSortCompare(List: TStringList; Index1, Index2: Integer): Integer;
begin
Result := StrToIntDef(List[Index1], 0) - StrToIntDef(List[Index2], 0)
end;

Related

How to populate a tree view based on recordset

From the query below
Select FIELD1,FIELD2,FIELD3,FIELD4 FROM MyTable Order By FIELD1,FIELD2,FIELD3,FIELD4 Group By FIELD1,FIELD2,FIELD3,FIELD4
I have a recordset like this:
I need to show data in a treeview like this:
I'm stuck with the code below.
var
Node: TTreeNode;
RootLevelCount: Integer;
X: Integer;
CurrentTextField: String;
MyTreeNodeText: array [0..10] of String;
begin
RootLevelCount := 4;
while not dm1.Q1.Eof do
begin
for X := 0 to RootLevelCount do
begin
CurrentTextField:=dm1.Q1.Fields[x].AsString;
if CurrentTextField='' then CurrentTextField := 'Level '+IntToStr(x);
if MyTreeNodeText[x]<>CurrentTextField then
begin
MyTreeNodeText[X]:=CurrentTextField;
if x=0 then
begin
Node:=tree.Items.AddFirst(Node, CurrentTextField);
end else
begin
node:=tree.Items.AddChild(node.Parent, CurrentTextField);
end;
end else
begin
node.GetNext;
end;
end;
dm1.Q1.Next;
end;
The result I have is the following and it's not I want:
After a good lunch, my mind has reborn then I found the solution.
var
Node: TTreeNode;
RootLevelCount: Integer;
X,X1: Integer;
CurrentTextField: String;
MyTreeNodeText: array [0..10] of String;
MyTreeNode: array [0..10] of TTreeNode;
begin
RootLevelCount := 4; //Number of fields that you want to show in the treeview
while not dm1.Q1.Eof do
begin
ROW_ID:=dm1.Q1.FieldByName('ROW_ID').AsString;
for X := 0 to RootLevelCount-1 do
begin
CurrentTextField:=dm1.Q1.Fields[4+x].AsString;
if CurrentTextField='' then CurrentTextField := 'Level '+IntToStr(x);
if MyTreeNodeText[x]<>CurrentTextField then
begin
MyTreeNodeText[X]:=CurrentTextField;
for X1 := x+1 to RootLevelCount-1 do
MyTreeNodeText[x1]:='';
if x=0 then
begin
Node:=tree.Items.Add(nil, CurrentTextField);
TMyTreeNode(Node).Indice:=StrToInt(ROW_ID);
MyTreeNode[x]:=node;
end else
begin
node:=tree.Items.AddChild(MyTreeNode[x-1], CurrentTextField);
TMyTreeNode(Node).Indice:=StrToInt(ROW_ID);
MyTreeNode[x]:=node;
end;
end;
end;
MyTreeNodeText[RootLevelCount]:='';
dm1.Q1.Next;
end;
then the result is the following:

FMX TGrid OnGetValue after column moving

I have Grid with enabled columns moving, and code:
type
TRec = record
Col0,
Col1,
Col2: string;
end;
var
Data: TArray<TRec>;
procedure TFormMain.GridGetValue(Sender: TObject; const Col, Row: Integer; var Value: TValue);
begin
case Col of
0: Value := Data[Row].Col0;
1: Value := Data[Row].Col1;
2: Value := Data[Row].Col2;
end;
end;
When column is moved this OnGetValue code works incorrectly (shown columns data on the previous positions). How to fix this? Should I use OnColumnMoved event and remember new columns position manually?
Ok, this is my own answer:
We should add helper function to our TRec for reading fields by index:
type
TRec = record
Col0,
Col1,
Col2: string;
function GetField(AIndex: Integer): string;
end;
function TRec.GetField(AIndex: Integer): string;
begin
case AIndex of
0: Result := Col0;
1: Result := Col1;
2: Result := Col2;
else
Result := '';
end;
end;
Also 2 functions to save and restore TGrid columns using Ini file:
type
TColumnData = record
Pos: UInt8;
Visible: Boolean;
Width: UInt16;
end;
procedure LoadColumns(AGrid: TGrid; const ASection, AIdent: string);
var
I, J, ColsSize: Integer;
A: TArray<TColumnData>;
Col: TColumn;
begin
for I := 0 to AGrid.ColumnCount - 1 do
AGrid.Columns[I].Tag := I;
SetLength(A, AGrid.ColumnCount);
ColsSize := AGrid.ColumnCount*SizeOf(TColumnData);
if ReadIni(<FileName>, ASection, AIdent, (#A[0])^, ColsSize) = ColsSize then
for J := 0 to AGrid.ColumnCount - 1 do begin
for I := 0 to AGrid.ColumnCount - 1 do begin
Col := AGrid.Columns[I];
if Col.Tag = A[J].Pos then begin
Col.Index := J;
Col.Visible := A[J].Visible;
Col.Width := A[J].Width;
end;
end;
end;
end;
procedure SaveColumns(AGrid: TGrid; const ASection, AIdent: string);
var
I, ColsSize: Integer;
A: TArray<TColumnData>;
Col: TColumn;
begin
SetLength(A, AGrid.ColumnCount);
ColsSize := AGrid.ColumnCount*SizeOf(TColumnData);
for I := 0 to AGrid.ColumnCount - 1 do begin
Col := AGrid.Columns[I];
A[I].Pos := Col.Tag;
A[I].Visible := Col.Visible;
A[I].Width := Round(Col.Width);
end;
WriteIni(<FileName>, ASection, AIdent, (#A[0])^, ColsSize);
end;
Now we should call LoadColumns (which is also initialize Tag fields for Columns) from OnFormCreate and SaveColumns from OnFormDestroy. And finally OnGetValue code:
var
Data: TArray<TRec>;
procedure TFormMain.GridGetValue(Sender: TObject; const Col, Row: Integer; var Value: TValue);
begin
Value := Data[Row].GetField((Sender as TGrid).Columns[Col].Tag);
end;

Delphi - Get line index and data index from given data

So I have list of data that may contain different charters:
1dAAbt54
agFlE9dA
1295RTdd
First line data contains: 1d, AA, bt, 54. All I need is function that gives me the data of given index. Example: data of index 6 is Fl (Line - 2, Index in line is 2). Every line lenght is 8 and data length is 2;
How can I make such function in Delphi?
The result function should be something like this:
procedure (DataList: TStringList; DataIndex: Integer; var LineIndex: Integer; var PosInLine: Integer);
begin
//do the algorithm
end;
Sorry for my bad english...
Answer to the first version of your question
The following is an answer to the first version of your question (before you edited it):
function GetIndexOfInteger(DataList: TStringList; DataIndex: Integer;
out LineIndex: Integer; out PosInLine: Integer): boolean;
var
x, y: Integer;
InNum: boolean;
NumStart: integer;
ValIndex: integer;
begin
result := false;
for y := 0 to DataList.Count - 1 do
begin
InNum := false;
ValIndex := 0;
for x := 1 to Length(DataList[y]) do
begin
if (DataList[y][x] <> chr(32)) and not InNum then
begin
NumStart := x;
InNum := true;
inc(ValIndex);
end;
if InNum and ((DataList[y][x] = chr(32)) or
(x = Length(DataList[y]))) then
begin
if StrToInt(Copy(DataList[y], NumStart, x - NumStart +
IfThen(x = Length(DataList[y]), 1))) = DataIndex then
begin
LineIndex := y + 1;
PosInLine := ValIndex;
result := true; // Roberts is on D7.
Exit; //
end;
InNum := false;
Continue;
end;
end;
end;
end;
Try it:
procedure TForm4.FormCreate(Sender: TObject);
var
SR: TStringList;
line, col: integer;
begin
SR := TStringList.Create;
SR.Add('1 2 3');
SR.Add('4 5 6');
SR.Add('7 8 9');
SR.Add('10 11 12 13');
if GetIndexOfInteger(SR, 13, line, col) then
ShowMessage(Format('%d, %d', [line,col]));
end;
Answer to the second version of your question
(And this is so easy you could've done it yourself! :)
function GetIndexOfItemInListOfPairs(DataList: TStringList; Data: String; out LineIndex: Integer; out PosInLine: Integer): boolean;
var
x, y: Integer;
begin
result := false;
for y := 0 to DataList.Count - 1 do
for x := 0 to Length(DataList[y]) div 2 - 1 do
if Copy(DataList[y], 2*x + 1, 2) = Data then
begin
LineIndex := y + 1;
PosInLine := x + 1;
Exit(true);
end;
end;
procedure TForm4.FormCreate(Sender: TObject);
var
SR: TStringList;
line,col:integer;
begin
SR := TStringList.Create;
SR.Add('1dAAbt54');
SR.Add('agFlE9dA');
SR.Add('1295RTdd');
if GetIndexOfItemInListOfPairs(SR, 'RT', line, col) then
ShowMessage(Format('%d, %d', [line,col]));
end;
Answer to the third version of your question
procedure TForm4.FormCreate(Sender: TObject);
var
RowIndex, ColIndex: Word;
begin
DivMod(6 {index} - 1, 4 {items per row}, RowIndex, ColIndex);
inc(RowIndex);
inc(ColIndex);
ShowMessageFmt('%d, %d', [RowIndex, ColIndex]);
end;
How about ...
procedure Search( DataList: TStringList; DataIndex: Integer; var LineIndex: Integer; var PosInLine: Integer);
var
j, LineLen: integer;
Line: string;
begin
LineIndex := 0;
PosInLine := 0;
for j := 0 to DataList.Count - 1 do
begin
Line := DataList[j];
Inc( LineIndex);
LineLen := Length( Line) div 2;
if DataIndex >= LineLen then
begin
Dec( DataIndex, LineLen);
continue
end;
PosInLine := LineLen;
break
end;
if PosInLine = 0 then // No find
LineIndex := 0
end;
Oops. The question has been changed completely. Here is the procedure for the question v 1.0 :)
procedure FindIndex(Data:TStringList; Index:integer;var LineIndex,PosInLine:Integer);
var i:integer;
CurrentStr:String;
StrToFind:String;
begin
LineIndex:=0;
PosInLine:=0;
StrToFind:=intToStr(Index)+' ';
for i:=0 to Data.Count-1 do
begin
CurrentStr:=' '+Data.Strings[i]+' ';
IF POS(' '+StrToFind,CurrentStr)>0 then
begin
LineIndex:=i+1;
//now we need to find PosInLine
PosInLine:=1;
repeat
CurrentStr:=Trim(CurrentStr)+' ';
IF Pos(StrToFind,CurrentStr)=1 then exit; //we found it
CurrentStr:=copy(CurrentStr,POS(' ',CurrentStr),length(CurrentStr));
inc(PosInLine);
until (CurrentStr='');
exit;
end;
end;
end;
Tested with this code
var T:TStringList;
Li,Pi:integer;
i:integer;
begin
T:=TStringList.Create();
T.Add('1 2 3');
T.Add(' 4 5 6');
T.Add('7 8 9');
T.Add('10 11 12 ');
for i:=0 to 13 do
begin
FindIndex(T,i,Li,Pi);
Memo1.Lines.Add(IntToStr(i)+':'+IntToStr(Li)+'-'+IntToStr(Pi))
end;
end;

How to load and save StringGrid content?

First part of the code works OK while the second (commented) does not.
It overwrites my A1 file although it should write to A2.
procedure TForm1.AdvGlowButton12Click(Sender: TObject);
var
i,j: Integer;
Seznam: TStrings;
ApplicationPath: string;
begin
if (cxRadiogroup3.ItemIndex and cxRadiogroup2.ItemIndex) = 0 then begin
ApplicationPath:= ExtractFileDir(Application.ExeName);
Seznam:= TStringList.Create;
try
for i:=0 to advStringGrid2.ColCount-1 do
Seznam.AddStrings(advStringGrid2.Cols [i]);
for i:=0 to advStringGrid2.rowCount-1 do
Seznam.AddStrings(advStringGrid2.rows [j]);
Seznam.SaveToFile(ApplicationPath+'\A1.txt');
finally
seznam.free;
end;
end ;
//if cxRadiogroup3.ItemIndex = 1 and cxRadiogroup2.ItemIndex = 0 then begin
// ApplicationPath:= ExtractFileDir(Application.ExeName);
// Seznam:= TStringList.Create;
// try
// for i:=0 to advStringGrid2.ColCount-1 do
// Seznam.AddStrings(advStringGrid2.Cols [i]);
// for i:=0 to advStringGrid2.rowCount-1 do
// Seznam.AddStrings(advStringGrid2.rows [j]);
// Seznam.SaveToFile(ApplicationPath+'\A2.txt');
// finally
// seznam.free;
// end ;
//end
end;
What am I doing wrong ?
Also why is the stringgrid giving listindex out of bounds when I try to load into it contents from an empty text file? If I save empty stringgrid to that file,later ,though it has nothing in the file,it does not complain? Strange...
This is how I load A1 and A2 into the stringgrid.
procedure TForm1.cxRadioGroup2Click(Sender: TObject);
Var
I,j,k: Integer;
Seznam: TStrings;
ApplicationPath: string;
begin
case cxradioGroup2.ItemIndex of
0: begin
if cxradioGroup3.ItemIndex = 0 then begin
Seznam:= TStringList.Create;
AdvStringgrid2.ClearAll;
try
Seznam.LoadFromFile('A1.txt');
k:= 0;
for i:=0 to advStringGrid2.ColCount-1 do
for j:=0 to advStringGrid2.RowCount-1 do begin
advstringGrid2.Cells [i,j]:= Seznam.Strings [k];
Inc(k);
end;
finally
seznam.free;
end;
end;
if cxradioGroup3.ItemIndex = 1 then begin
Seznam:= TStringList.Create;
AdvStringgrid2.ClearAll;
try
Seznam.LoadFromFile('A2.txt');
k:=0;
for i:=0 to advStringGrid2.ColCount-1 do
for j:=0 to advStringGrid2.RowCount-1 do begin
advstringGrid2.Cells [i,j]:= Seznam.Strings [k];
Inc(k);
end;
finally
seznam.free;
end;
end;
end;
end;
end;
here is an old tipp from SwissDelphiCenter that could help you
// Save StringGrid1 to 'c:\temp.txt':
procedure TForm1.Button1Click(Sender: TObject);
begin
SaveStringGrid(StringGrid1, 'c:\temp.txt');
end;
// Load StringGrid1 from 'c:\temp.txt':
procedure TForm1.Button2Click(Sender: TObject);
begin
LoadStringGrid(StringGrid1, 'c:\temp.txt');
end;
// Save a TStringGrid to a file
procedure SaveStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var
f: TextFile;
i, k: Integer;
begin
AssignFile(f, FileName);
Rewrite(f);
with StringGrid do
begin
// Write number of Columns/Rows
Writeln(f, ColCount);
Writeln(f, RowCount);
// loop through cells
for i := 0 to ColCount - 1 do
for k := 0 to RowCount - 1 do
Writeln(F, Cells[i, k]);
end;
CloseFile(F);
end;
// Load a TStringGrid from a file
procedure LoadStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var
f: TextFile;
iTmp, i, k: Integer;
strTemp: String;
begin
AssignFile(f, FileName);
Reset(f);
with StringGrid do
begin
// Get number of columns
Readln(f, iTmp);
ColCount := iTmp;
// Get number of rows
Readln(f, iTmp);
RowCount := iTmp;
// loop through cells & fill in values
for i := 0 to ColCount - 1 do
for k := 0 to RowCount - 1 do
begin
Readln(f, strTemp);
Cells[i, k] := strTemp;
end;
end;
CloseFile(f);
end;
I'm trying to understand your code and tried him as good as it is possible for me to rewrite. (it's not tested)
procedure TForm1.AdvGlowButton12Click(Sender: TObject);
var
i, j: Integer;
Seznam: TStrings;
ApplicationPath: string;
fileName: string;
line: string;
begin
if (cxRadiogroup2.ItemIndex = 0) then begin
if (cxRadiogroup3.ItemIndex = 0) then
fileName:= 'A1.txt'
else
fileName:= 'A2.txt'
ApplicationPath:= ExtractFileDir(Application.ExeName);
Seznam:= TStringList.Create;
try
for k:=0 to advStringGrid2.RowCount-1 do begin
line:= '';
for i:=0 to advStringGrid2.ColCount-1 do
line = line + '|' + advStringGrid2.Cells[i, k];
Seznam.AddStrings(line);
end;
Seznam.SaveToFile(ApplicationPath + '\' + fileName);
finally
seznam.Free;
end;
end;
end;
procedure TForm1.cxRadioGroup2Click(Sender: TObject);
var
splitList: TStringList;
i, j: Integer;
Seznam: TStrings;
ApplicationPath: string;
fileName: string;
line: string;
sepIndex: integer;
begin
if (cxRadiogroup2.ItemIndex = 0) then begin
if (cxRadiogroup3.ItemIndex = 0) then
fileName:= 'A1.txt'
else
fileName:= 'A2.txt'
AdvStringgrid2.ClearAll; // don't know what this does
ApplicationPath:= ExtractFileDir(Application.ExeName);
Seznam:= TStringList.Create;
try
Seznam.LoadFromFile(fileName);
advstringGrid2.RowCount:= Seznam.Count;
splitList:= TStringList.Create;
for i:=0 to Seznam.Count-1 do begin
line:= Seznam.Strings [i];
Split('|', line, splitList);
advStringGrid2.ColCount:= Max(advStringGrid2.ColCount, splitList.Count);
for k:=0 to splitList.Count-1 do
advStringGrid2.Cells[i, k]:= splitList[k];
end;
finally
splitList.Free;
seznam.Free;
end;
end;
end;
procedure Split (const Delimiter: Char; Input: string; const Strings: TStrings);
begin
Assert(Assigned(Strings));
Strings.Clear;
Strings.Delimiter:= Delimiter;
Strings.DelimitedText:= Input;
end;
hope that helps
How do you know it is overwriting A1.txt? You are saving the exact same contents in both cases.
Founded and adapted to my needs. Then shared :-)
procedure LoadStringGrid(const AFileName: TFileName; AGrid: TStringGrid);
var
slRows: TStringList;
i: integer;
begin
slRows:= TStringList.Create;
try
slRows.LoadFromFile(AFileName);
for i:= 0 to slRows.Count -1 do
AGrid.Rows[i +1].CommaText:= slRows[i];
finally
slRows.Free;
end;
end;// LoadStringGrid
procedure SaveStringGrid(const AFileName: TFileName; AGrid: TStringGrid);
var
slRows: TStringList;
i: integer;
begin
slRows:= TStringList.Create;
try
for i:= 1 to AGrid.RowCount -1 do
slRows.Add(AGrid.Rows[i].CommaText);
slRows.SaveToFile(AFileName);
finally
slRows.Free;
end;
end;// SaveStringGrid

How can I quickly convert an array of numeral characters into an integer?

Situation: a whole number saved as hex in a byte array(TBytes). Convert that number to type integer with less copying, if possible without any copying.
here's an example:
array = ($35, $36, $37);
This is '5', '6', '7' in ansi. How do I convert it to 567(=$273) with less trouble?
I did it by copying twice. Is it possible to be done faster? How?
You can use LookUp Table instead HexToInt...
This procedure works only with AnsiChars and of course no error checking is provided!
var
Table :array[byte]of byte;
procedure InitLookupTable;
var
n: integer;
begin
for n := 0 to Length(Table) do
case n of
ord('0')..ord('9'): Table[n] := n - ord('0');
ord('A')..ord('F'): Table[n] := n - ord('A') + 10;
ord('a')..ord('f'): Table[n] := n - ord('a') + 10;
else Table[n] := 0;
end;
end;
function HexToInt(var hex: TBytes): integer;
var
n: integer;
begin
result := 0;
for n := 0 to Length(hex) -1 do
result := result shl 4 + Table[ord(hex[n])];
end;
function BytesToInt(const bytes: TBytes): integer;
var
i: integer;
begin
result := 0;
for i := 0 to high(bytes) do
result := (result shl 4) + HexToInt(bytes[i]);
end;
As PA pointed out, this will overflow with enough digits, of course. The implementation of HexToInt is left as an exercise to the reader, as is error handling.
You can do
function CharArrToInteger(const Arr: TBytes): integer;
var
s: AnsiString;
begin
SetLength(s, length(Arr));
Move(Arr[0], s[1], length(s));
result := StrToInt(s);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
a: TBytes;
begin
a := TBytes.Create($35, $36, $37);
Caption := IntToStr(CharArrToInteger(a));
end;
If you know that the string is null-terminated, that is, if the final character in the array is 0, then you can just do
function CharArrToInteger(const Arr: TBytes): integer;
begin
result := StrToInt(PAnsiChar(#Arr[0]));
end;
procedure TForm1.FormCreate(Sender: TObject);
var
a: TBytes;
begin
a := TBytes.Create($35, $36, $37, 0);
Caption := IntToStr(CharArrToInteger(a));
end;
The most natural approach, however, is to use an array of characters instead of an array of bytes! Then the compiler can do some tricks for you:
procedure TForm1.FormCreate(Sender: TObject);
var
a: TCharArray;
begin
a := TCharArray.Create(#$35, #$36, #$37);
Caption := IntToStr(StrToInt(string(a)));
end;
It cannot be any faster than that ;-)
function HexToInt(num:pointer; size:Cardinal): UInt64;
var i: integer;
inp: Cardinal absolute num;
begin
if(size > SizeOf(Result)) then Exit;
result := 0;
for i := 0 to size-1 do begin
result := result shl 4;
case(PByte(inp+i)^) of
ord('0')..ord('9'): Inc(Result, PByte(inp+i)^ - ord('0'));
ord('A')..ord('F'): Inc(Result, PByte(inp+i)^ - ord('A') + 10);
ord('a')..ord('f'): Inc(Result, PByte(inp+i)^ - ord('a') + 10);
end;
end;
end;
function fHexToInt(b:TBytes): UInt64; inline;
begin
Result:=HexToInt(#b[0], Length(b));
end;
...
b:TBytes = ($35, $36, $37);
HexToInt(#b[0], 3);
fHexToInt(b);

Resources