1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
| unit UI2C;
//I2C By Montor
interface
type
TStateI2C = 0..1;
TBaseI2C =class
protected
procedure WaitUs(AUs: integer);
procedure BusWrite(ASCL,ASDA:TStateI2C);virtual;abstract;
function SDA_Read():TStateI2C;virtual;abstract;
public
function Open(ADevice: Byte; AWrite: boolean =False): boolean;
procedure Write(Value: Byte);
function Read(): Byte;
procedure Start();
procedure Stop();
procedure Init();
function Ack(): boolean;
function NAck(): boolean;
procedure Master_Ack();
function IsPresent(ADevice:Byte):boolean;
end;
TLTPI2C =class(TBaseI2C)
protected
procedure BusWrite(ASCL,ASDA:TStateI2C);override;
function SDA_Read():TStateI2C;override;
end;
implementation
uses windows;
function Inp32(PortAddress:integer):Integer;stdcall;external 'inpout32.dll';
procedure Out32(PortAddress,Value : Integer);stdcall;external 'inpout32.dll';
procedure TBaseI2C.WaitUs(AUs:integer);
var
mFreq,mStart,mEnd:int64;
begin
QueryPerformanceFrequency(mFreq);
QueryPerformanceCounter(mStart);
repeat
QueryPerformanceCounter(mEnd);
until ((mEnd - mStart)*1000000 div mFreq )> AUs;
end;
procedure TBaseI2C.Write(Value:Byte);
var
I :integer;
D :TStateI2C;
begin
for I := 0 to 7 do
begin
D:=(Value and $80)shr 7;
BusWrite(0,D);
BusWrite(1,D);
Value := Value shl 1;
end;
end;
function TBaseI2C.Read():Byte;
var
I:integer;
begin
Result := 0;
for I := 7 downto 0 do
begin
BusWrite(0,1);
BusWrite(1,1);
Result:= Result or ( Byte(SDA_Read()) shl I);
end;
end;
procedure TBaseI2C.Start();
begin
BusWrite(1,1);
BusWrite(1,0);
BusWrite(0,0);
end;
procedure TBaseI2C.Stop();
begin
BusWrite(0,0);
BusWrite(1,0);
BusWrite(1,1);
end;
function TBaseI2C.Ack():boolean;
begin
BusWrite(0,1);
BusWrite(1,1);
Result := SDA_Read() = 0;
end;
function TBaseI2C.NAck():boolean;
begin
BusWrite(0,1);
BusWrite(1,1);
Result := SDA_Read() = 1;
BusWrite(0,1);
end;
procedure TBaseI2C.Init();
begin
Start();
Start();
Stop();
end;
procedure TBaseI2C.Master_Ack();
begin
BusWrite(0,0);
BusWrite(1,0);
BusWrite(0,0);
end;
function TBaseI2C.Open(ADevice:Byte;AWrite:boolean):boolean;
begin
Start();
if AWrite then
Write(ADevice and $FE)
else
Write(ADevice or $01);
Result := Ack;
end;
function TBaseI2C.IsPresent(ADevice:Byte):boolean;
begin
Init();
Start();
Write(ADevice);
Result:=Ack();
Nack();
Stop();
end;
{ TLTPI2C }
function TLTPI2C.SDA_Read: TStateI2C;
begin // /ACK Pin 10
WaitUs(10);
Result := not(Inp32($378+1)shr 6)and 1;
end;
procedure TLTPI2C.BusWrite(ASCL, ASDA: TStateI2C);
begin
// D0 ->SCL D2 -> SDA
Out32($378,not(ASCL or ASDA shl 2) and 5);
WaitUs(400);
end;
end. |
I2c sur port LPT
Répondre avec citation
Partager