So this could be hard to explain but i want to do a for ... := 1 to 10 do statement but i want it to be for A to N do. The main purpose of this excersise is to load data into a string grid. So lets have it load the cells 0,1 0,2 0,3 0,4 0,5 0,6 0,7 with the Letter A, B, C, D, E all the way up to 14. If anyone knows how to do this i would be extremely thankful!
Here you got it, but I'm not sure if it's a good way how to learn programming (I mean asking question as requests so that someone else write code for you):
procedure TForm1.Button1Click(Sender: TObject);
var
I: Integer;
begin
StringGrid1.FixedCols := 1;
StringGrid1.ColCount := 15;
for I := 1 to 14 do
StringGrid1.Cells[I, 1] := Chr(Ord('A') + I - 1);
end;
If you want to fill the StringGrid control one row at a time, you can do
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
StringGrid1.FixedCols := 1;
StringGrid1.FixedRows := 1;
for i := 0 to Min(25, (StringGrid1.ColCount-1) * (StringGrid1.RowCount-1)) do
StringGrid1.Cells[i mod (StringGrid1.ColCount - 1) + 1,
i div (StringGrid1.ColCount - 1) + 1] := Chr(Ord('A') + i);
end;
which works no matter how many rows and cols there are.
Want to fuse TLama's answer with that "want to do a for ... := 1 to 10 do statement but i want it to be for A to N do"
Don't know if it will be pun, or enlightening.
var c: char; i: integer;
s: string;
...
i := 0; s:= EmptyStr;
for c := 'A' to 'N' do begin
s := s + c + ',';
Inc(i);
end;
SetLength(s, Length(s) - 1); // we do not need last comma there
StringGrid1.ColCount := i;
StringGrid1.Rows[0].CommaText := s;
Or the same using TStringBuilder - which would be faster than re-arranging Heap on each new string modification.
uses SysUtils;
...
var c: char; i: integer;
s: string;
...
i := 0;
with TStringBuilder.Create do try
for c := 'A' to 'N' do begin
Append(c + ',');
Inc(i);
end;
s := ToString;
finally
Free;
end;
SetLength(s, Length(s) - 1); // we do not need last comma there
StringGrid1.ColCount := i;
StringGrid1.Rows[0].CommaText := s;
Related
This question already has answers here:
Converting decimal/integer to binary - how and why it works the way it does?
(6 answers)
Closed 4 years ago.
I have done some Example to convert a string to binary but i couldn't find a way to walk on each character in the string and complete the whole calculations process and then step to the next character in the string, Here is my code:
var i,j, rest, results :integer;
restResult : string;
begin
results := 1;
for i := 1 to length(stringValue) do
begin
while (results > 0) do
begin
results := ord(stringValue[i]) div 2;
rest := ord(stringValue[i]) mod 2;
restResult := restResult + inttostr(rest);
end;
end;
// Get The Rests Backwards
for i := length(restResult) downto 1 do
begin
result := result + restResult[i];
end;
The application always get into infinite loop, any suggestions?
Your results := ord(stringValue[i]) div 2; remains the same, because stringValue[i] does not change, so while loop is infinite.
To solve this mistake:
for i := 1 to length(stringValue) do
begin
t := ord(stringValue[i]);
repeat
restResult := restResult + inttostr(t mod 2);
t := t div 2;
until t = 0;
end;
But note that you cannot divide resulting string into pieces for distinct chars, because length of binary representation will vary depending on char itself.
This is example of code with fixed length for representation of char (here AnsiChar):
function AnsiStringToBinaryString(const s: AnsiString): String;
const
SBits: array[0..1] of string = ('0', '1');
var
i, k, t: Integer;
schar: string;
begin
Result := '';
for i := 1 to Length(s) do begin
t := Ord(s[i]);
schar := '';
for k := 1 to 8 * SizeOf(AnsiChar) do begin
schar := SBits[t mod 2] + schar;
t := t div 2
end;
Result := Result + schar;
end;
end;
'#A z': (division bars are mine)
01000000|01000001|00100000|01111010
# A space z
Say I have the data
1,2,3,4,5,6
I want to sort this data so that it outputs
6 1 5 2 4 3
This way, numbers are matched so that low numbers pair with high numbers
Would i use a merge sort to sort it in numerical order, then split the list and match them according to this conditions?
I'm trying to sort real number data in a string grid which is read from a data file; I have a working program that sorts these data in numerical order but I'm not sure how to code it so that it sorts in terms of high,low,high,low
This is the code for my grid sorting
procedure TForm1.SortGrid(Grid: TStringGrid; const SortCol: Integer;
//sorting the string grid
const datatype: Integer; const ascending: boolean);
var
i: Integer;
tempgrid: TStringGrid;
list: array of Integer;
begin
tempgrid := TStringGrid.create(self);
with tempgrid do
begin
rowcount := Grid.rowcount;
ColCount := Grid.ColCount;
fixedrows := Grid.fixedrows;
end;
with Grid do
begin
setlength(list, rowcount - fixedrows);
for i := fixedrows to rowcount - 1 do
begin
list[i - fixedrows] := i;
tempgrid.rows[i].assign(Grid.rows[i]);
end;
Mergesort(Grid, list, SortCol + 1, datatype, ascending);
for i := 0 to rowcount - fixedrows - 1 do
begin
rows[i + fixedrows].assign(tempgrid.rows[list[i]])
end;
row := fixedrows;
end;
tempgrid.free;
setlength(list, 0);
end;
First, sort the numbers in descending order by using any algorithm you want (I used bubble sort in example)
Then, if you have n elements in array:
set a counter going from 1 to (n div 2)
take last element and store it in temporary variable (tmp)
shift all elements by one place to the right, starting from (counter - 1) * 2 + 1. This would overwrite last element, but you have it stored in tmp var
set array[(counter - 1) * 2 + 1] element to tmp
end counter
This way you would effectively take last element from array and insert it at 1, 3, 5... position, until you insert last half of array elements.
Sample code:
procedure Sort(var AArray: array of Double);
var
C1, C2: Integer;
tmp : Double;
pivot : Integer;
begin
for C1 := Low(AArray) to High(AArray) - 1 do
for C2 := C1 + 1 to High(AArray) do
if AArray[C1] < AArray[C2] then
begin
tmp := AArray[C1];
AArray[C1] := AArray[C2];
AArray[C2] := tmp;
end;
pivot := Length(AArray) div 2;
for C1 := 1 to pivot do
begin
tmp := AArray[High(AArray)];
for C2 := High(AArray) downto (C1 - 1) * 2 + 1 do
AArray[C2] := AArray[C2 - 1];
AArray[(C1 - 1) * 2 + 1] := tmp;
end;
end;
From sample data you provided above, I am assuming that the input array is presorted.
[Note that I don't have a compiler at hand, so you'll have to run it and see that it works --minor fiddling might be needed.]
procedure SerratedSort(var AArray: array of Double);
var
Length1: Integer;
Index1: Integer;
Temp1: Double;
begin
Length1 := Length(AArray);
Index1 := 0;
while Index1 < Length1 do begin
Temp1 := AArray[Length1 - 1];
System.Move(AArray[Index1], AArray[Index1 + 1], (Length1 - Index1 + 1) * SizeOf(Double));
AArray[Index1] := Temp1;
Index1 := Index1 + 2;
end;
end;
Here is how it (should) work(s) step-by-step
Input AArray: 123456
Index1: 0
Temp1 := 6
System.Move: 112345
AArray: 612345
Index1: 2
Temp1 := 5
System.Move: 612234
AArray: 615234
Index1: 4
Temp1 := 4
System.Move: 615233
AArray: 615243
Output AArray: 615243
For a record structure, such as, TPerson, it would be like this:
procedure SerratedSort(var A: array of TPerson);
var
s: Integer;
i: Integer;
t: TPerson;
begin
s := Length(A);
i := 0;
while i < s do begin
t := A[s - 1];
System.Move(A[i], A[i + 1], (s - i + 1) * SizeOf(TPerson));
A[i] := t;
i := i + 2;
end;
end;
Sort the data in ascending order. Then pick out the values using the following indices: 0, n-1, 1, n-2, ....
In pseudo code the algorithm looks like this:
Sort;
lo := 0;
hi := n-1;
while lo<=hi do
begin
yield lo;
inc(lo);
if lo>hi then break;
yield hi;
dec(hi);
end;
Example program demonstrating the already above given solutions:
program Project1;
{$APPTYPE CONSOLE}
const
Count = 12;
type
TValues = array[0..Count - 1] of Double;
const
Input: TValues = (1,2,4,9,13,14,15,23,60,100,101,102);
var
I: Integer;
Output: TValues;
procedure ShowValues(Caption: String; Values: TValues);
var
I: Integer;
begin
Write(Caption);
for I := 0 to Count - 2 do
Write(Round(Values[I]), ', ');
WriteLn(Round(Values[Count - 1]));
end;
begin
if Odd(Count) then
WriteLn('Cannot compute an odd number of input values')
else
begin
WriteLn('Program assumes sorted input!');
ShowValues('Input: ', Input);
for I := 0 to (Count div 2) - 1 do
begin
Output[2 * I] := Input[I];
Output[2 * I + 1] := Input[Count - 1 - I];
end;
ShowValues('Output: ', Output);
end;
ReadLn;
end.
I have a DB grid which is sorted (the user clicked a few radio buttons and checkboxes to influence the display).
I would like to export all of the data (not just what is visible in the grid), sorted identically, to CSV - how do I do so? The data - not the user settings, just to clarify.
Thanks in advance for any help
[Update] I build sqlQuery bit by bit, depending on the user's settings of checkboxes & radio groups, then, when one of them changes, I
ActivityADQuery.SQL.Clear();
ActivityADQuery.SQL.Add(sqlQuery);
ActivityADQuery.Open(sqlQuery);
That is to say that there isn't a hard coded query, it varies and I want to export the current settings.
I don't know enough if I want to export from the grid or the dataset (I am just not a db guy, this is my first DBgrid), but I suspect that I want the grid, because it has a subset of fields of he dataset.
I guess that TJvDBGridCSVExport is a Jedi component(?) I have tried to avoid them so far, great as they sound, because I prefer discreet, stand-alone, components to installing a huge collection. That may not be the cleverest thing to do, but it's how I feel - ymmv (and prolly does)
Another solution, works also with (multi)selected rows:
procedure TReportsForm.ExportToCSV(const aGrid : TDBGrid; const FileName : String);
Var
I, J : Integer;
SavePlace : TBookmark;
Table : TStrings;
HeadTable : String;
LineTable : String;
First : Boolean;
Begin
HeadTable := '';
LineTable := '';
Table := TStringList.Create;
First := True;
Try
For I := 0 To Pred(aGrid.Columns.Count) Do
If aGrid.Columns[I].Visible Then
If First Then
Begin
// Use the text from the grid, in case it has been set programatically
// E.g., we prefer to show "Date/time" than "from_unixtime(activity.time_stamp, "%D %b %Y %l:%i:%S")"
// HeadTable := HeadTable + aGrid.Columns[I].FieldName;
HeadTable := HeadTable + ActivityReportStringGrid.Columns[i].Title.Caption + ','; // Previous separated wth semi-colon, not comma! (global)
First := False;
End
Else
begin
// HeadTable := HeadTable + ';' + aGrid.Columns[I].FieldName;
HeadTable := HeadTable + ActivityReportStringGrid.Columns[i].Title.Caption + ',';
end;
Delete(HeadTable, Length(HeadTable), 1); // Remove the superfluous trailing comma
Table.Add(HeadTable);
First := True;
// with selection of rows
If aGrid.SelectedRows.Count > 0 Then
Begin
For i := 0 To aGrid.SelectedRows.Count - 1 Do
Begin
aGrid.DataSource.Dataset.GotoBookmark(pointer(aGrid.SelectedRows.Items[i]));
For j := 0 To aGrid.Columns.Count - 1 Do
If aGrid.Columns[J].Visible Then
If First Then
Begin
lineTable := lineTable + aGrid.Fields[J].AsString;
First := False;
End
Else
lineTable := lineTable + ',' + aGrid.Fields[J].AsString;
Delete(LineTable, Length(LineTable), 1); // Remove the superfluous trailing comma
Table.Add(LineTable);
LineTable := '';
First := True;
End;
End
Else
//no selection
Begin
SavePlace := aGrid.DataSource.Dataset.GetBookmark;
aGrid.DataSource.Dataset.First;
Try
While Not aGrid.DataSource.Dataset.Eof Do
Begin
For I := 0 To aGrid.Columns.Count - 1 Do
If aGrid.Columns[I].Visible Then
If First Then
Begin
lineTable := lineTable + aGrid.Fields[I].AsString;
First := False;
End
Else
lineTable := lineTable + ',' + aGrid.Fields[I].AsString;
Delete(LineTable, Length(LineTable), 1); // Remove the superfluous trailing comma
Table.Add(LineTable);
LineTable := '';
aGrid.DataSource.Dataset.Next;
First := True;
End;
aGrid.DataSource.Dataset.GotoBookmark(SavePlace);
Finally
aGrid.DataSource.Dataset.FreeBookmark(SavePlace);
End;
End;
Table.SaveToFile(FileName);
Finally
Table.Free;
End;
End; // ExportToCSV()
You could use a own tiny procedure wich could be adapted to your needs
Procedure Dataset2SeparatedFile(ads: TDataset; const fn: String; const Separator: String = ';');
var
sl: TStringList;
s: String;
i: Integer;
bm: TBookmark;
Procedure ClipIt;
begin
s := Copy(s, 1, Length(s) - Length(Separator));
sl.Add(s);
s := '';
end;
Function FixIt(const s: String): String;
begin
// maybe changed
Result := StringReplace(StringReplace(StringReplace(s, Separator, '', [rfReplaceAll]), #13, '', [rfReplaceAll]), #10, '', [rfReplaceAll]);
// additional changes could be Quoting Strings
end;
begin
sl := TStringList.Create;
try
s := '';
For i := 0 to ads.FieldCount - 1 do
begin
if ads.Fields[i].Visible then
s := s + FixIt(ads.Fields[i].DisplayLabel) + Separator;
end;
ClipIt;
bm := ads.GetBookmark;
ads.DisableControls;
try
ads.First;
while not ads.Eof do
begin
For i := 0 to ads.FieldCount - 1 do
begin
if ads.Fields[i].Visible then
s := s + FixIt(ads.Fields[i].DisplayText) + Separator;
end;
ClipIt;
ads.Next;
end;
ads.GotoBookmark(bm);
finally
ads.EnableControls;
ads.FreeBookmark(bm);
end;
sl.SaveToFile(fn);
finally
sl.Free;
end;
end;
i want to get value from two file .txt, one file contain different dimension matrix with other
i have try this code:
procedure TfrmJST.ParseDelimited(const S1: TStrings; const Value: String; const Delimiter: String);
var
dx,cx: integer;
ns,ms: String;
txt: string;
delta,teta: integer;
procedure TfrmJST.ParseDelimited(const S1: TStrings; const Value: String; const Delimiter: String);
var
dx,cx: integer;
ns,ms: String;
txt: string;
delta,teta: integer;
begin
Col := 1;
Delta := Length(Delimiter);
Txt := Value+Delimiter;;
begin
while Length(Txt) > 1 do
begin
Dx := Pos(Delimiter, Txt);
Ns := Trim(Copy(Txt, 1, Dx-1));
// S1.Add('#'+Ns+'*'); //only needed for testing
if Ns <> '' then
begin
Matrix[Row,Col] := StrToFloat(Ns); //for first matrix
Inc(Col);
end;
Txt := Copy(Txt, Dx+Delta, MaxInt);
end;
end;
Col := 1;
teta := Length(delimiter);
txt := value+delimiter;
begin
while Length(txt) > 1 do
begin
cx := Pos(delimiter, txt);
ms := Copy(txt, 1, cx-1);
if ms <> '' then
begin
ref[Row,Col] := StrToFloat(ms); ///for 2nd matrix
Inc(Col);
end;
txt := Copy(txt, cx+teta, MaxInt);
end;
end;
end;
and this is initialize of matrix:
private
{ Private declarations }
Row, Col: integer;
Matrix: array[1..140,1..141] of double;
Ref: array[1..2,1..140] of double ;
this is the implementation:
begin
Temp := TStringList.Create;
MemoSL:= TStringList.Create ;
Temp.LoadFromFile('trainer.txt');
Row := 1;
for I := 0 to Temp.Count-1 do
begin
ParseDelimited(MemoSL, Trim(Temp.Strings[I]), ' ');
Inc(Row); //stackoverflow error in this line
end;
Temp.Free;
//parsing second matrix
TempList := TStringList.Create;
Templist.LoadFromFile('refbaru.txt');
row := 1;
for J := 0 to Templist.Count-1 do
begin
T := Templist[J];
ParseDelimited(Memo1.Lines, T, ' ');
Inc(row);
end;
Templist.Free;
i tried that code but give me error,
the error was stackoverflow error in line 'inc(row)' that process first matrix.
and while i gave comment out at the second function that process 2nd matrix, Temp[i] only returns 2 rows of matrix[140x141]. does it mean the code can't process two different file? and why it only return two rows of the matrix?
anyone can help me?
while Length(Txt) > 1 do
begin
Dx := Pos(Delimiter, Txt);
Ns := Trim(Copy(Txt, 1, Dx-1));
// S1.Add('#'+Ns+'*'); //only needed for testing
if Ns <> '' then
begin
Matrix[Row,Col] := StrToFloat(Ns); //for first matrix
Inc(Col);
end;
Txt := Copy(Txt, Dx+Delta, MaxInt);
end;
Looking at this piece of code I see the posibility of an endless loop: what happens if there is no Delimiter found? It will keep running and forever increase your 'col' value. Make sure to have a condition to stop your while loop if no delimeter is found.
It is pointless to look for a specific stack overflow error when many ordinary errors already exist.
If your code is clean programmed and it is still stack overflow, then of course, is time to look deeper into the code.
But first ! As long as you can see obvious errors, you should remove them.
1.) "Row" used in the same procedure on a 140 dimension array and on a only 2 dimension array.
How can that work ?
Matrix: array[1..140,1..141] of double;
Ref: array[1..2,1..140] of double ;
File 'trainer.txt' 140 Lines
File 'refbaru.txt' 2 Lines.
for I := 0 to Temp.Count-1 do // 140 lines
// ParseDelimited() will only run properly if Row < 3
// remember -> Ref: array[1..2,1..140])
// if Row > 2 , with Ref[Row,Col] := , 137 times data is overwritten.
procedure ParseDelimited(MemoSL, Trim(Temp.Strings[I]), ' ');
....
Matrix[Row,Col] := StrToFloat(Ns);
....
Ref[Row,Col] := StrToFloat(ms);
....
end;
Inc(Row);
end;
2.) If you run the second loop with refbaru.txt and the two arrays are present together in the procedure ParseDelimited(), then you overwrite 2 values of array Matrix
recommendation
make sure: Loop through trainer.txt, writes values only to the Matrix array.
make sure: Loop through refbaru.txt, writes values only to the Ref array.
Your code could look something like:
[...]
filetoload: String;
[...]
procedure TfrmJST.ParseDelimited(S1: TStrings; Value: String; const Delimiter: String);
var
f:double;
[...]
Col := 1;
txt := Value+Delimiter;
[...]
if filetoload='trainer.txt' then begin
Delta := Length(Delimiter);
while Length(txt) > 1 do
begin
Dx := Pos(Delimiter, txt);
Ns := Trim(Copy(txt, 1, Dx-1));
if Ns <> '' then
begin
if TryStrToFloat(Ns,f) then Matrix[Row,Col]:=f;
Inc(Col);
if Col > MatrixColMax then break;
txt := Copy(txt, Dx+Delta, MaxInt);
end else txt:='';
end;
end;
if filetoload='refbaru.txt' then begin
teta := Length(delimiter);
while Length(txt) > 1 do
begin
cx := Pos(delimiter, txt);
ms := Copy(txt, 1, cx-1);
if ms <> '' then
begin
if TryStrToFloat(ms,f) then Ref[Row,Col]:=f;
Inc(Col);
if Col > RefColMax then break;
txt := Copy(txt, cx+teta, MaxInt);
end else txt:='';
end;
end;
begin
[...]
filetoload:='trainer.txt';
Temp := TStringList.Create;
Temp.LoadFromFile(filetoload);
if Temp.Count > MatrixRowMax then LinesToLoad:=MatrixRowMax-1 else
LinesToLoad:=Temp.Count-1;
for I := 0 to LinesToLoad do
[...]
ParseDelimited(MemoSL, Trim(Temp.Strings[I]), ' ');
[...]
end;
filetoload:='refbaru.txt';
TempList := TStringList.Create;
TempList.LoadFromFile(filetoload);
if TempList.Count > RefRowMax then LinesToLoad:=RefRowMax-1 else
LinesToLoad:=TempList.Count-1;
for J := 0 to LinesToLoad do
[...]
ParseDelimited(Memo1.Lines, T, ' ');
[...]
end;
end;
You should also compare the linesize of the file with the size of the arrays
RefRowMax: integer;
RefColMax: integer;
MatrixRowMax: integer;
MatrixColMax: integer;
LinesToLoad: integer;
....
RefRowMax:=2;
RefColMax:=140;
MatrixRowMax:=140;
MatrixColMax:=141;
....
procedure ParseDelimited()
if filetoload='trainer.txt' then begin
[...]
Inc(Col)
if Col > MatrixColMax then break;
end;
if filetoload='refbaru.txt' then begin
[...]
Inc(Col)
if Col > RefColMax then break;
end;
You should also look for a valid value of Ns , StrToFloat(Ns) before you write to the arrays in ParseDelimited()
function TryStrToFloat(const S: string; out Value: Double): Boolean;
or
Val();
var
f:double;
....
begin
....
if TryStrToFloat(Ns,f) then Matrix[Row,Col]:=f;
....
The OP overwritting many of used data.
And when he has enough data overwritten, he gets a stack overflow error.
I am trying to make a basic Hex viewer out of a TMemo, I know this is probably not ideal but it will be only me personally using it so that does not really matter.
(1)
Firstly, suppose a Memo is filled with Hex information like so:
How could I get a count of all the text blocks shown, ignoring the white space? So using the image the result in this case would be 28.
This is what I tried and I know it is completely wrong as I am accessing the Memo lines but I don't know how to access each character.
I cant seem to solve this simple problem :(
function CountWordBlocks(Memo: TMemo): Integer;
var
i: Integer;
vCount: Integer;
begin
for i := 0 to Memo.Lines.Count - 1 do
begin
if Length(Memo.Lines.Strings[i]) = 2 then
begin
Inc(vCount);
end;
end;
Result := vCount;
end;
Here is the code I am using to display the Hex values in the Memo:
procedure ReadFileAsHex(const AFileName: string; ADestination: TStrings);
var
fs: TFileStream;
buff: Byte;
linecount: Byte;
line: string;
begin
linecount := 0;
line := '';
fs := TFileStream.Create(AFileName, fmOpenRead);
try
ADestination.BeginUpdate;
try
while fs.Position < fs.Size do
begin
fs.Read(buff, 1);
line := line + IntToHex(buff, 2) + ' ';
Inc(linecount);
if linecount = 16 then
begin
ADestination.Add(line);
line := '';
linecount := 0;
end;
end;
if Length(line) <> 0 then
ADestination.Add(line);
finally
ADestination.EndUpdate;
end;
finally
fs.Free;
end;
end;
(2)
If I click onto the Memo and a text block is under the cursor, how could I know which number the selected block is out of all the others?
So using the same first image, the caret is at the top line next to 68, so the result would be 3 as it is the third text block out of 28.
This should be so easy but I cannot think clearly, I don't have the right programming mind yet and so really struggle with basic logic and solving problems!
(3)
Finally I would like to select a block at runtime by passing a block number value. I tried this without much success:
procedure FindBlock(Memo: TMemo; BlockNumber: Integer);
var
i: Integer;
txt: string;
ThisWhite, PrevWhite: boolean;
vRead: Integer;
begin
txt := Memo.Text;
vRead:= 0;
PrevWhite := True;
for i := 1 to Length(txt) do
begin
ThisWhite := Character.IsWhiteSpace(txt[i]);
if PrevWhite and not ThisWhite then
begin
Inc(vRead);
PrevWhite := False;
end;
PrevWhite := ThisWhite;
if vRead = BlockNumber then
begin
Memo.SelStart := vRead;
Memo.SetFocus;
Exit;
end;
end;
end;
(1)
This works:
function TForm1.CountBlocks: integer;
var
i: Integer;
txt: string;
ThisWhite, PrevWhite: boolean;
begin
txt := Memo1.Text;
result:= 0;
PrevWhite := true;
for i := 1 to Length(txt) do
begin
ThisWhite := Character.IsWhiteSpace(txt[i]);
if PrevWhite and not ThisWhite then
begin
inc(result);
PrevWhite := false;
end;
PrevWhite := ThisWhite;
end;
end;
However, it can be optimized if more detailed information about the memo contents is available. For instance, if you know that each line consists of four blocks, then the number of blocks is simply 4*Memo1.Lines.Count. My code above will even accept blocks of different width.
(2)
Simply replace
for i := 1 to Length(txt) do
by
for i := 1 to Memo1.SelStart + 1 do
Since you are in control of the formatting of your lines, and the lines have a fixed format, it is very easy to calculate the number of bytes being displayed without resorting to looping through the individual lines one a time. Every line displays 3 characters per byte, and every line other than the last line displays 16 bytes, thus 48 characters per complete 16-byte line. Use those facts to your advantage to calculate the number of bytes based on the number of complete 16-byte lines present, and then you can add on the number of remaining bytes from just the last line:
function CountWordBlocks(Memo: TMemo): Integer;
var
Count: Integer;
begin
Count := Memo.Lines.Count;
if Count > 0 then
Result := (16 * (Count-1)) + (Length(Memo.Lines[Count-1]) div 3);
else
Result := 0;
end;
You can do something similar to translate a character offset within the Memo into a work block number:
function GetCurrentWordBlock(Memo: TMemo): Integer;
var
SelStart, LineStart, LineNum: Integer
begin
Result := 0;
SelStart := Memo.SelStart;
if SelStart < 0 then Exit;
LineStart := Memo.Perform(EM_LINEINDEX, SelStart, 0);
if LineStart < 0 then Exit;
LineNum := Memo.Perform(EM_LINEFROMCHAR, LineStart, 0);
Result := (16 * LineNum) + ((SelStart - LineStart) div 3) + 1;
end;
To select a given block number, you can do this:
procedure FindBlock(Memo: TMemo; BlockNumber: Integer);
var
LineNum, LineStart: Integer;
begin
if BlockNumber < 1 then Exit;
LineNum = (BlockNumber - 1) div 16;
LineStart = Memo.Perform(EM_LINEINDEX, LineNum, 0);
if LineStart < 0 then Exit;
Memo.SelStart = LineStart + (((BlockNumber - 1) - (16 * LineNum)) * 3);
Memo.SelLength := 2;
Memo.SetFocus;
end;