Код: 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. | 
)
