CODEWITHSUNDEEP
delphi
peiman F.
peiman F.

Reputation: 1658

Delphi speed up decode and show a custom image

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}

  1. Get first string from string list

  2. Convert it to binary and append to previous data

  3. Find sync word and copy data after sync word

  4. Split image data to 1024 * 10 bits to load image

  5. Draw image from data

  6. 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.

Upvotes: 0

Views: 407

Answers (1)

whosrdaddy
whosrdaddy

Reputation: 11859

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.

Upvotes: 1

Related Questions