procedure TForm1.ReadBtnClick(Sender: TObject);
begin
  i2c_Start;
  i2c_Write($A0); //!!!!!!$A0 Команда : ще записваме адреса от който четем !!!!!!!!
  i2c_Write($00); // Адрес от който ще четеме
  i2c_Start; // !!!!!Пак стартов бит !!!!!
  i2c_Write($A1); //!!!!!$A1 Командата ще четем е чак тук !!!!!
  Temp := i2c_Read(True); // True --> ще четеме само 1 байт
//  i2c_SendNotAck;   /// Tova za sega ne e aktualno. Ste go gledam kato priema nesto razlicno ot 0
  i2c_Stop;
//  i2c_Delay; //-> от това няма нужда, даже можеш всички delay да махнеш от кода
end;

function TForm1.GetCTS : integer;
var
  lpModemStatus : DWORD ;
begin
  GetCommModemStatus(hCom_ComRW, lpModemStatus);
  if (lpModemStatus = MS_CTS_ON) then         //!!!!!!!!!Tova e casten slucaj samo za CTS ne e universalno(COM-a ne se polzva za drugo)
    CTS_Signal := 1
  else
    CTS_Signal := 0;
  Result := CTS_Signal;
end;



function TForm1.i2c_Read(Last : Boolean ) : Byte;
var
  Byt : string;
  i : integer;
begin
  SetDTR_SDA(0);  //CLEAR_SDA();
  i2c_Delay;
//* Initialize byte value */
  Byt := '';
  //* Receive BYTE, MSB first */
  for i:=1 to 8 do
  begin
    i2c_Delay;
    SetRTS_SCL(1);  // SET_SCL(); SCL = 1
    i2c_Delay;
    if GetCTS() = 1 then
      i2c_Delay;
    Byt := Byt + IntToStr(CTS_Signal);

    SetRTS_SCL(0);   //CLEAR_SCL(); SCL = 0
    i2c_Delay;
    if GetCTS() = 1 then
      i2c_Delay;
  end;

// Get ready for acknowledge: is it the last byte to read ? */
  if( Last ) then
    SetDTR_SDA(1)   // SET_SDA();
  else
    begin
    //------------  Acknolige  ---------------------
      SetDTR_SDA(0);   // CLEAR_SDA();
      i2c_delay;
      //* Get the acknowledge */
      SetRTS_SCL(1);  // SET_SCL();
      i2c_delay;

      if GetCTS()=1 then
         Error_NoACK := True
      else
         Error_NoACK := False;

      SetRTS_SCL(0);  //CLEAR_SCL();
      i2c_delay;
    //------------  Acknolige  ---------------------
    end;
  Result := BinToInt(Byt);
end;

implementation

{$R *.dfm}

procedure TTForm24C04.i2c_Delay;
begin
  Sleep(0);
end;


//**************************************************************
//****************  Predavame prez DTR *************************
//****************  Priemame prez  CTS *************************
//****************  Taktuvame prez RTS *************************
//**************************************************************

procedure TTForm24C04.ReadBtnClick(Sender: TObject);
var
  Temp : integer;
begin
  MyInitComm(strComPort, BoundRate, BiteCount, nStopBits); // Vrasta hCom_ComRW na otvoreniq COM-port
  fReading := True;
  bStop5VThread_ComRW := False;
  bExitThread := False;
  StartCommThread(Self, TForm24C04.WindowHandle); // Podava 5v zaxranvane na shemata
  i2c_Delay;

//*********** Cetene ot pametta *****************

  i2c_Start;
  i2c_Write($A0); //!!!!!!$A0 Komanda : ste zapisvame adresa ot koito ceteme --> Page 0!!!!!!!!
  i2c_Write($00); // Address/offset ot koito ste ceteme --> Page 0 address $00
  i2c_Start; // !!!!!Startov bit !!!!!
  i2c_Write($A1); //!!!!!$A1 Komanda - ste cetem !!!!!
  i2c_Delay;
  Temp := i2c_Read(True); // True --> cetem samo 1 byte
  i2c_SendNotAck;
  i2c_Stop;

  bStop5VThread_ComRW := True;
  bExitThread := True;
  fReading := False;

  Edit1.Text := Edit1.Text + '  ' + IntToHex(Temp,2);
  CloseHandle(hCom_ComRW);
end;


function TTForm24C04.i2c_Read(Last : Boolean ) : Byte;
var
  Byt : string;
  i : integer;
begin
  SetDTR_SDA(0);  //CLEAR_SDA();
  i2c_Delay;
//* Initialize byte value */
  Byt := '';
  //* Receive BYTE, MSB first */
  for i:=1 to 8 do
  begin
    i2c_Delay;
    SetRTS_SCL(1);  // SET_SCL(); SCL = 1
    i2c_Delay;
    if GetCTS = 1 then
      i2c_Delay;
    Byt := Byt + IntToStr(CTS_Signal);

    SetRTS_SCL(0);   //CLEAR_SCL(); SCL = 0
    i2c_Delay;
    if GetCTS = 1 then
      i2c_Delay;
  end;

// Get ready for acknowledge: is it the last byte to read ? */
  if( Last ) then
    SetDTR_SDA(1)   // SET_SDA();
  else
    begin
    //------------  Acknolige  ---------------------
      SetDTR_SDA(0);   // CLEAR_SDA();
      i2c_delay;
      //* Get the acknowledge */
      SetRTS_SCL(1);  // SET_SCL();
      i2c_delay;

      if GetCTS=1 then
         Error_NoACK := True
      else
         Error_NoACK := False;

      SetRTS_SCL(0);  //CLEAR_SCL();
      i2c_delay;
    //------------  Acknolige  ---------------------
    end;
  Result := BinToInt(Byt);
end;

procedure TTForm24C04.i2c_write(byt : Byte);
   { Write a byte to the I2C bus; errors are stored in I2C_Status
     and can be inspected by calling i2c_status() */ }
var
  i, Comp : integer;
begin
  Num := Byt;
  //* Send BYTE, MSB first */
  for i:=1 to 8 do
  begin
    Comp := Num and $80;
    if Comp > 0 then
      SetDTR_SDA(1)   // SET_SDA();
    else
      SetDTR_SDA(0);   // CLEAR_SDA();
    //* Get ready for next bit */
    Num := Num Shl 1;  //// //byt <<= 1;
    if Num>$FF then
      Num := Lo(Num);    //// Pravi go do byte

    SetRTS_SCL(1);  // SET_SCL();
    i2c_delay;
    SetRTS_SCL(0);  //CLEAR_SCL();
    i2c_delay;
    Application.ProcessMessages;
  end;

  SetDTR_SDA(0);   // CLEAR_SDA();
  i2c_delay;
  //* Get the acknowledge */
  SetRTS_SCL(1);  // SET_SCL();
  i2c_delay;
  Application.ProcessMessages;
  if GetCTS=1 then
     Error_NoACK := True
  else
     Error_NoACK := False;

  SetRTS_SCL(0);  //CLEAR_SCL();
  i2c_delay;
end;

//* ------------------------------------------------------------------------ */

function TTForm24C04.GetCTS : integer;
var
  lpModemStatus : DWORD ;
begin
  GetCommModemStatus(hCom_ComRW, lpModemStatus);
  if (lpModemStatus = MS_CTS_ON) then //Tova e casten slucaj samo za CTS ne e universalno
    CTS_Signal := 1
  else
    CTS_Signal := 0;
  Result := CTS_Signal;
end;

procedure TTForm24C04.i2c_Start;
begin
//* Generate I2C START condition */
  SetDTR_SDA(1);  //SDA = 1
  SetRTS_SCL(1);   // SCL = 1
  i2c_delay;
  SetDTR_SDA(0);  //SDA = 0
  i2c_delay;
  SetRTS_SCL(0);   // SCL = 0
  i2c_delay;
end;

procedure TTForm24C04.i2c_Stop;
begin
  //* Generate I2C STOP condition */
  SetDTR_SDA(0);   // CLEAR_SDA();
  i2c_delay;
  SetRTS_SCL(1);  // SET_SCL();
  i2c_delay;
  SetDTR_SDA(1);   // SET_SDA();
  i2c_delay;
end;

// Master in receive mode must generate AckNo signal for slave
procedure TTForm24C04.i2c_SendAck;
begin
   SetDTR_SDA(0);   // _SDA = 0;
   i2c_Delay;
   SetRTS_SCL(1);  // _SCL = 1;
   i2c_Delay;
   SetRTS_SCL(0);   // _SCL = 0;
   i2c_Delay;
end;

procedure TTForm24C04.i2c_SendNotAck;
begin
   SetDTR_SDA(1);   // _SDA = 1;
   i2c_Delay;
   SetRTS_SCL(1);  // _SCL = 1;
   i2c_Delay;
   SetRTS_SCL(0);  // _SCL = 0;
   i2c_Delay;
end;

procedure TTForm24C04.i2c_RepStart(i2cslave : Byte);
begin
   i2cslave := $A1;  // The device address is 1010 0001b Address = $00 s posleden bit=1 za cetene
   SetDTR_SDA(1);   // _SDA = 1;
   i2c_Delay;
   i2c_Start;
   // Write device address for read operation
   i2c_Write(i2cslave);
end;

procedure TTForm24C04.FormCreate(Sender: TObject);
begin
  fReading := False;
  WriteCount := 1;
//*********************************************************************
  Error_NoACK := False;
  strComPort  := 'COM1';
  BoundRate   := 19200;
  BiteCount   := 8;
  nStopBits   := ONESTOPBIT;
  bExitThread := False;
  bStop5VThread_ComRW := False;

  MainWnd := TForm24C04.WindowHandle;  // Pokazva na Thread-a za BarCodReader-a na koj prozorec da prati saobstenieto
//  MyInitComm(strComPort, BoundRate, BiteCount, nStopBits);

//  StartCommThread(Self, TForm24C04.WindowHandle); // Caka za signal po CTS

//*********************************************************************
  Num := 13;

end;

procedure TTForm24C04.OnMyMessage(var Msg: TMessage);
begin
  if CTS_Signal = 1 then
    CTSShape.Brush.Color := clLime
  else
    CTSShape.Brush.Color := clSilver;

end;

procedure TTForm24C04.ExitThreadBtnClick(Sender: TObject);
begin
  bStop5VThread_ComRW := True;
  bExitThread := True;
end;

procedure TTForm24C04.SetDtrBtnClick(Sender: TObject);
begin
  fReading := True;
  SetDTR_SDA(1);
  Sleep(1);
  if CTS_Signal = 1 then
    CTSShape.Brush.Color := clLime
  else
    CTSShape.Brush.Color := clSilver;
  Application.ProcessMessages;
  Edit1.Text := 'Start';
  fReading := False;
end;

procedure TTForm24C04.ClearDTRBtnClick(Sender: TObject);
begin
  fReading := True;
  SetDTR_SDA(0);
  fReading := False;
end;

procedure TTForm24C04.StarThreadBtnClick(Sender: TObject);
begin
  bStop5VThread_ComRW := False;
  bExitThread := False;
  StartCommThread(Self, TForm24C04.WindowHandle); // Caka za signal po CTS
end;

function TTForm24C04.BinToInt(Value : string) : longInt;
  function Stepen(Value : Real;Stp : integer) : real;
  var
    i : integer;
  begin
    Result := 1;
    for i:=1 to Stp do
      Result := Result*Value;
  end;

var
  i, Len : integer;
  Str : string;
begin
  Result := 0;
  Len := 0;
  Str := '';
  for i:= 1 to Length(Value) do
    if not(Value[i] = ' ') then
    begin
      Inc(Len);
      Str := Str + Value[i];
    end;
  Value := Str;
  for i:= 1 to Len do
    Result :=Result+StrToInt(Value[i])*Round(Stepen(2,Length(Value)-i));
end;

function TTForm24C04.IntToBin(Value : LongInt; FillByte : integer):string;
var
  EndConvert : Boolean;
  i : integer;
begin
  EndConvert := False;
  Result := '';
  while not EndConvert do
  begin
    if (Value mod 2)=0 then
      Result := '0'+ Result
    else
      Result := '1'+ Result;
    Value := Value div 2;
    if Value = 0 then
      EndConvert := True;
  end;
  if Length(Result) < FillByte then
    for i:= Length(Result)+1 to FillByte do
      Result := '0' + Result;
end;

procedure TTForm24C04.WriteBtnClick(Sender: TObject);
var
//  sBufToSend, sBufRead : String;
//  i : integer;
  Temp : integer;
  Offset : Byte;
begin
  Temp := 12;
  fReading := True;
  bStop5VThread_ComRW := False;
  bExitThread := False;

  MyInitComm(strComPort, BoundRate, BiteCount, nStopBits);

  StartCommThread(Self, TForm24C04.WindowHandle); // Caka za signal po CTS

  i2c_Delay;

  for WriteCount:=1 to 32 do
  begin
    i2c_start();
    if WriteCount<=16 then
      begin
        i2c_write($A0); //$A0  êîìàíäà : ùå çàïèñâàìå Page 0
        Application.ProcessMessages;
        Sleep(40);
        Offset := 1;
      end
    else
      begin
        i2c_write($A2); //$A0  êîìàíäà : ùå çàïèñâàìå Page 1
        Application.ProcessMessages;
        Sleep(40);
        Offset := 17;
      end;
    i2c_write((WriteCount - Offset)*$10); // Àäðåñ íà, êîéòî ùå çàïèñâàìå
    i2c_write($00); // Äàííè
    i2c_write($01);
    i2c_write($02);
    i2c_write($03);
    i2c_write($04);
    i2c_write($05);
    i2c_write($06);
    i2c_write($07);
    i2c_write($08);
    i2c_write($09);
    i2c_write($10);
    i2c_write($11);
    i2c_write($12);
    i2c_write($13);
    i2c_write($14);
    i2c_write($15);
    i2c_stop();
    Application.ProcessMessages;
    Sleep(40);
    i2c_Delay;
  end;

  bStop5VThread_ComRW := True;
  bExitThread := True;
  fReading := False;

  Edit1.Text := IntToHex(Temp,2);
  CloseHandle(hCom_ComRW);

end;

end.

function I2C_Read: byte;
var res: byte;
      ...
begin
...
...
res := 0;

For i:= 0 to 7 do
   begin
   ...
     res := res or (CTS_Signal shl (7-i));
     // или още по просто и оптмизирано на долните два реда
     #asm
     ror res,1; // завъртане на res надясно
     #end
     res := res or (CTS_Signal);
   ...
   end;
result := res;
end;