Delphi speed up decode and show a custom image - delphi

Question

In my project I receive data from a tcp connection with a custom protocol in packets of 1095 bytes, then I must look for a sync word and try to show gray scale image.
At first step I read data and save them in a TStringList fifo
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
rowFrame : string;
data: TIdBytes;
begin
offReCStatus := false;
repeat
AContext.Connection.IOHandler.ReadBytes(data, 1099, False);
rowFrame :='';
for I := 0 to length(data)-1 do
begin
rowFrame := rowFrame + (data[i].ToHexString);
end;
tcpFrameList.Append( rowFrame );
until offReCStatus = true;
end;
Then in a separated thread, I try the data from the list.
{I added some comments in code}
Get first string from string list
Convert it to binary and append to previous data
Find sync word and copy data after sync word
Split image data to 1024 * 10 bits to load image
Draw image from data
Find new sync word(number 3)
Note: one very important thing is the sync-word is not byte,its bits and can start from middle of a byte for example 10 101011-00010101-00001100-10011001-01111111-00 111111 in this case 10 at first and 111111 at the end merged to sync word and its not AC543265FC‬ any more.in the past in fpga I wrote code that shift the bits until find the 40 bits sync word but i don't know how this can be done in Delphi!
procedure TMyThread.Execute;
var
str3,str4,frameStr,frameId,strData, str6 : string;
iPos,y ,imageBit , frameIdNum :integer;
imageRol : TStringList;
begin
while not Terminated do
begin
FTermEvent.WaitFor( 500 );
if not Terminated then
begin
while tcpFrameList.Count >0 do //process que
begin
try
dta := dta + HexStrToBinStr(tcpFrameList[0]);//convert hex data to binary string and append to olddata
tcpFrameList.Delete(0);//delete converted thread
str3 := '1010110001010100001100100110010111111100';//sync word ‭"AC543265FC‬"
iPos := pos( str3 , dta );//find 1st sync word in binary data
while dta.Length>20000 do //process data to find sync words
begin
Delete(dta,1, iPos-1 );//delete data until first sync word
str4 := copy( dta , 1, 12240);//copy image frame data after sync word
Delete(dta,1, 12240 );//delete image frame data that copied
strData := copy(BinToHex(str4),11); //hex image data
frameId := copy( strData , 1, 6 ); //get image column id from data
frameStr := copy( strData , 107, 330 );//get image color data as protocol
frameStr := frameStr + copy( strData , 501, 446 );//get image data as in protocol
frameStr := frameStr + copy( strData , 1011, 446 );//get image data as in protocol
frameStr := frameStr + copy( strData , 1521, 446 );//get image data as in protocol
frameStr := frameStr + copy( strData , 2031, 446 );//get image data as in protocol
frameStr := frameStr + copy( strData , 2541, 446 );//get image data as in protocol
imageBin := HexStrToBinStr( frameStr );
//now we have 10240 bit that for one frame column .10240 is 1024 of 10 bits for each pixel
imageRol := TstringList.Create;
imageRol := spliToLength( imageBin,10);//split 10240 to 1024 *10
frameIdNum := HexToDec(frameId);//frame id to show image
//application.ProcessMessages;
TThread.Synchronize (TThread.CurrentThread,
procedure () var y,n:integer;
begin
form1.Image1.Width := frameIdNum+1;//set TImage width
for y := 0 to imageRol.Count-1 do //process imageRol to grab 1024 pixel color of new column
begin
str6 := imageRol[y];
imageBit := trunc( BinToDec( str6 ) /4 );//div 10bit(1024) to 4 to get a number 0-255 for color
form1.Image1.Canvas.Pixels[frameIdNum ,y)] := RGB( imageBit , imageBit , imageBit );//gray scale image
end;
end);
iPos := pos( str3 , dta );
end;
except
on E : Exception do
TThread.Synchronize (TThread.CurrentThread,
procedure ()
begin
form1.Memo1.Lines.Add(E.ClassName+' , message: '+E.Message);
end);
end;
end;
end;
end;
end;
The code above is working good but its slow..
I don't know how can process data as bits so try to convert data between hex and string to complete the process. Is there a way to do this job without any hex converting from tcp layer!?
I commented the code to explain what happening.but tell me to add some more data where necessary.

Answer 1

Here is an example how you could process the Binary data.
DISCLAMER
This code sample is far from optimized as I tried to keep it simple so one can grasp the concept how to process binary data.
The main concept here is that we have a 40 bit sync word (marker) but since we are dealing with individual bits, it can be on a non byte boundary. So all we need to do is read at least 48 bits (6 bytes) into a 64 bit integer and shift the bits to the right until we find our marker. I did not include the RGB pixel extraction logic, I leave that as an exercise for you :), I think you can decode it with WIC as GUID_WICPixelFormat32bppBGR101010
program SO59584303;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Classes,
System.SysUtils;
type ImageArray = TArray<Byte>;
const FrameSync : UInt64 = $AC543265FC; // we need Int64 as our marker is > 32 bits
function GetByte(const Value : UInt64; const ByteNum : Byte) : Byte; inline;
begin
Result := (Value shr ((ByteNum-1)*8)) and $FF ;
end;
procedure WriteInt64BigEndian(const Value: UInt64; NumberOfBytes : Integer; var Stream : TBytes; var Ps : Integer);
var
I : Integer;
begin
for I := NumberOfBytes downto 1 do
begin
Stream[Ps] := GetByte(Value, I);
Inc(Ps);
end;
end;
function ReadInt64BigEndian(const NumberOfBytes : Integer; const Stream : TBytes; var Ps : Integer) : UInt64;
var
I : Integer;
B : Byte;
begin
Result := 0;
for I := NumberOfBytes downto 1 do
begin
B := Stream[Ps];
Result := Result or (UInt64(B) shl ((I-1)* 8));
Inc(Ps);
// sanity check
if Ps >= Length(Stream) then
Exit;
end;
end;
procedure ReadPixelData(const Stream : TBytes; Var Ps : Integer; const Shift : Byte; var Buffer : ImageArray);
// our buffer
var
I : UInt64;
BPos : Integer;
begin
BPos := 0;
// 1024 * 10 bit pixel = 10240 bits = 1280 bytes // initialize buffer
SetLength(Buffer, 1280);
// fill with 0's
FillChar(Buffer[0], Length(Buffer), 0);
if Shift = 0 then
begin
// if we are byte boundary, we can just copy our data
Move(Stream[Ps], Buffer[0], Length(Buffer));
Inc(Ps, Length(Buffer));
end
else
while Bpos < Length(Buffer) do
begin
// Read 8 bytes at a time and shift x bits to the right, mask off highest byte
// this means we can get max 7 bytes at a time
I := (ReadInt64BigEndian(8, Stream, Ps) shr Shift) and $00FFFFFFFFFFFFFF;
// Write 7 bytes to our image data buffer
WriteInt64BigEndian(I, 7, Buffer, BPos);
// go one position back for the next msb bits
Dec(Ps);
end;
end;
procedure WritePixelData(var Stream : TBytes; Var Ps : Integer; var Shift : Byte);
var
Count : Integer;
ByteNum : Byte;
Data : UInt64;
begin
for Count := 1 to 160 do
begin
// write four bytes at a time, due to the shifting we get 5 bytes in total
Data := $F1F2F3F4;
if (Shift > 0) then
begin
// special case, we need to fillup shift bits on last written byte in the buffer with highest byte from our UInt64
Data := Data shl Shift;
Stream[Ps-1] := Stream[Ps-1] or GetByte(Data, 5);
end;
WriteInt64BigEndian(Data, 4, Stream, Ps);
Data := $F5F6F7F8;
if (Shift > 0) then
begin
// special case, we need to fillup shift bits on last written byte in the buffer with highest byte from our UInt64
Data := Data shl Shift;
Stream[Ps-1] := Stream[Ps-1] or GetByte(Data, 5);
end;
WriteInt64BigEndian(Data, 4, Stream, Ps);
end;
end;
procedure GenerateData(var Stream : TBytes);
var
Count : Integer;
I : UInt64;
Ps : Integer;
Shift : Byte;
begin
Count := 1285*4+10;
SetLength(Stream, Count); // make room for 4 Imageframes (1280 bytes or 10240 bits) and 5 byte marker (40 bits) + 10 bytes extra room
FillChar(Stream[0], Count, 0);
Ps := 1;
// first write some garbage
Stream[0] := $AF;
// our first marker will be shifted 3 bits to the left
Shift := 3;
I := FrameSync shl Shift;
// write our Framesync (40+ bits = 6 bytes)
WriteInt64BigEndian(I, 6, Stream, Ps);
// add our data, 1280 bytes or 160 times 8 bytes, we use $F1 F2 F3 F4 F5 F6 F7 F8 as sequence
// (fits in Int 64) so that we can verify our decoding stage later on
WritePixelData(Stream, Ps, Shift);
// write some garbage
Stream[Ps] := $AE;
Inc(Ps);
// our second marker will be shifted 2 bits to the left
Shift := 2;
I := FrameSync shl Shift;
WriteInt64BigEndian(I, 6, Stream, Ps);
WritePixelData(Stream, Ps, Shift);
// write some garbage
Stream[Ps] := $AD;
Inc(Ps);
// our third marker will be shifted 1 bit to the left
Shift := 1;
I := FrameSync shl Shift;
WriteInt64BigEndian(I, 6, Stream, Ps);
WritePixelData(Stream, Ps, Shift);
// write some garbage
Stream[Ps] := $AC;
Inc(Ps);
// our third marker will be shifted 5 bits to the left
Shift := 5;
I := FrameSync shl Shift;
WriteInt64BigEndian(I, 6, Stream, Ps);
WritePixelData(Stream, Ps, Shift);
SetLength(Stream, Ps-1)
end;
procedure DecodeData(const Stream : TBytes);
var
Ps : Integer;
OrgPs : Integer;
BPos : Integer;
I : UInt64;
Check : UInt64;
Shift : Byte;
ByteNum : Byte;
ImageData : ImageArray;
begin
Ps := 0;
Shift := 0;
while Ps < Length(Stream) do
begin
// try to find a marker
// determine the number of bytes we need to read, 40bits = 5 bytes,
// when we have shifted bits this will require 6 bytes
if Shift = 0 then
ByteNum := 5
else
ByteNum := 6;
// save initial position in the stream
OrgPs := Ps;
// read our marker
I := ReadInt64BigEndian(ByteNum, Stream, Ps);
// if we have shifted bits, shift them on byte boundary and make sure we only have the 40 lower bits
if Shift > 0 then
I := (I shr Shift) and $FFFFFFFFFF;
if I = FrameSync then
begin
// we found our marker, process pixel data (ie read next 10240 bits, taking shift into account)
// If we have shift, our first bits will be found in the last marker byte, so go back one position in the stream
if Shift > 0 then
Dec(Ps);
ReadPixelData(Stream, Ps, Shift, ImageData);
// process Image array accordingly, here we will just check that we have our written data back
BPos := 0;
Check := $F1F2F3F4F5F6F7F8;
for ByteNum := 1 to 160 do
begin
I := ReadInt64BigEndian(8, ImageData, BPos);
// if our data is not correct, raise error
Assert(I = Check, 'error decoding image data');
end;
end
else
begin
Ps := OrgPs;
// we did not find our marker, advance 1 bit
Inc(Shift);
if Shift > 7 then
begin
// reset shift value
Shift := 0;
// advance to next byte boundary
Inc(Ps);
end;
end;
end;
end;
Var
AStream : TBytes;
begin
try
GenerateData(AStream);
DecodeData(AStream);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.