?? pci7233.pas
字號(hào):
unit PCI7233;
interface
uses
SysUtils,Windows,Forms,messages,Classes,Graphics,ExtCtrls,Dask7230;
const INTAccessMsg = WM_USER+400;
type
TMode=(TINT,TLOOK);
TOnIntEvent= procedure(Sender:TObject; aState:DWord; Port:SmallInt) of Object ;
TOnLogEvent= procedure(Sender:TObject; msg:string) of Object ;
TPCI7233 = class(TPanel)
private
CallbackFunc: TCallbackFunc;
FMode:TMode;
FID:smallint;
FSaveState: DWord;
FWaitState: DWord;
RePeatCount:Integer;
FTimer:TTimer;
FOnColor: TColor;
FOFFColor: TColor;
FOnIntEvent: TOnIntEvent;
FOnOffChgColor: TColor;
FOnOffChgBit:Byte;
FIntBusying: Boolean;
FWaitTime: Integer;
FOnLogEvent: TOnLogEvent;
procedure SetSaveState(const Value: DWord);
procedure SetOffColor(const Value: TColor);
procedure SetOnColor(const Value: TColor);
procedure SetOnOffChgColor(const Value: TColor);
procedure SetWaitTime(const Value: Integer);
{ Private declarations }
protected
procedure Paint; override;
procedure DoLogEvent(msg:string);
procedure OnCall(var message:Tmessage); message INTAccessMsg;
procedure OnExpTime(sender:TObject);
{ Protected declarations }
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Open;
procedure Close;
procedure SetMode(Mode:TMode);
Function ReadPort:Dword;
Function ReadPortEX(SetpTime,SetpCount: Integer ):Dword;
Function GetChangeBit(TestState:DWord):Byte;
Function SaveStateBit1(B1_32:byte):Boolean;
Function SaveStateBit0(B1_32:byte):Boolean;
Property IntBusying:Boolean read FIntBusying write FIntBusying;
{ Test }
Function NewState(chgBit:Byte):Dword;
procedure Test;
procedure Test2;
published
Property OnColor: TColor read FOnColor write SetOnColor;
Property OffColor: TColor read FOffColor write SetOFFColor;
Property OnOffChgColor: TColor read FOnOffChgColor write SetOnOffChgColor;
Property WaitTime: Integer read FWaitTime write SetWaitTime;
Property OnIntEvent:TOnIntEvent read FOnIntEvent write FOnIntEvent;
Property OnLogEvent:TOnLogEvent read FOnLogEvent write FOnLogEvent;
{ Published declarations }
end;
procedure Register;
implementation
//uses Unit1;
procedure Register;
begin
RegisterComponents('Standard', [TPCI7233]);
end;
procedure delay(ms:DWORD);
var t:DWORD;
begin
t:=gettickcount;
while gettickcount <t+ms do
application.ProcessMessages;
end;
// bit =(1..32)
Function _Bit1(X:DWord;bit:byte):boolean;
begin
bit := bit -1;
result:=(X and ($01 shl bit)) <>0;
end;
Function _Bit0(X:DWord;bit:byte):boolean;
begin
bit := bit -1;
result:=(X and ($01 shl bit)) =0;
end;
constructor TPCI7233.Create(AOwner: TComponent);
begin
inherited;
FOnColor:=clred;
FOFFColor:=clWhite;
FIntBusying:=False;
FWaitTime :=60000;
FTimer:=TTimer.Create(self);
FTimer.Enabled:=False;
FTimer.Interval:=FWaitTime;
FTimer.OnTimer:=OnExpTime;
RePeatCount:=0;
end;
destructor TPCI7233.Destroy;
begin
FTimer.Free;
inherited;
end;
{ TPCI7233 }
procedure TPCI7233.Paint;
var i,B,L,DX:Integer; Ri:Trect; S:string;
W:double;
begin
inherited;
B:=(borderWidth+bevelWidth);
W:= (ClientWidth - 2* B) / 32 ;
for i:=1 to 32 do begin
L:= B+ Trunc((i-1)* W);
Ri:=Rect(L,ClientRect.Top+B, Trunc( L+W ), ClientRect.Bottom-B );
InflateRECT(Ri,-1,-1 );
if _Bit1(FSaveState,i) then canvas.Brush.Color:=FOnColor
else canvas.Brush.Color:=FOffColor ;
if FOnOffChgBit = i then begin
canvas.font.Color:=OnOffChgColor ;
canvas.font.Style:=[fsBold] ;
end else canvas.font:=font ;
S:= inttostr(i) ;
Dx:= Trunc( (W- Canvas.TextWidth(S)) / 2 );
Canvas.TextRect(Ri,Ri.Left+Dx,Ri.Top-1,S );
// L:=L+W;
end;
end;
procedure TPCI7233.Close;
begin
if FID>0 then Release_Card( FID);
end;
procedure TPCI7233.Open;
begin
FID:=-1;
FID:=Register_Card(PCI_7233,0);
setMode(TLOOK);
end;
procedure TPCI7233.SetMode(Mode: TMode);
begin
if FID<0 then exit;
if FMode = Mode then exit;
FMode := Mode ;
case FMode of
TINT: begin
DIO_INT2_EventMessage(FID,INT2_EXT_SIGNAL, Handle,INTAccessMsg,CallbackFunc) ;
DIO_INT1_EventMessage(FID,INT1_EXT_SIGNAL, Handle,INTAccessMsg,CallbackFunc) ;
end;
TLooK: begin
DIO_INT2_EventMessage(FID,INT2_DISABLE, Handle,INTAccessMsg,CallbackFunc) ;
DIO_INT1_EventMessage(FID,INT1_DISABLE, Handle,INTAccessMsg,CallbackFunc) ;
end;
end;
end;
procedure TPCI7233.SetSaveState(const Value: DWord);
begin
FOnOffChgBit:=GetChangeBit(Value) ;
FSaveState := Value;
DoLogEvent( format('更新?tīng)顟B(tài)為%x',[FSaveState]));
Repaint;
end;
procedure TPCI7233.SetOFFColor(const Value: TColor);
begin
FOffColor := Value; Repaint;
end;
procedure TPCI7233.SetOnColor(const Value: TColor);
begin
FOnColor := Value; Repaint;
end;
Function TPCI7233.NewState(chgBit:Byte):Dword;
var M:dword;
begin
result:= FSaveState;
if chgBit<=0 then exit;
if chgBit>32 then exit;
M:= $01 shl (chgBit-1) ;
if _Bit0(FSaveState,chgBit) then result:= FSaveState or m
Else result := FSaveState Xor m;
end;
function TPCI7233.GetChangeBit(TestState: DWord): Byte;
var i:Integer;
begin
result:=0;
for i:=1 to 32 do begin
if _Bit1(FSaveState,i)<>_Bit1(TestState,i) then begin
result:= i; exit;
end;
end;
end;
function TPCI7233.ReadPort: Dword;
begin
// result:=NewState(tag);
//exit;
result:=0;
if FID>=0 then DI_ReadPort(FID,0,result);
result := result xor $FFFFFFFF;
end;
procedure TPCI7233.Test;
begin
sendmessage(handle,INTAccessMsg,0,0);
end;
procedure TPCI7233.OnCall(var message: Tmessage);
var aState :DWord;
begin
if IntBusying then exit; //阻斷中斷響應(yīng)
IntBusying:=True; //關(guān)中斷響應(yīng)
// 延時(shí)查詢進(jìn)行中斷確認(rèn)
Astate:= ReadPortEX( 100,10);
DoLogEvent( format('中斷響應(yīng)到：確認(rèn)狀態(tài)= %x',[aState]));
if Astate = FSaveState then begin // 中斷確認(rèn)無(wú)變化= FSaveState
IntBusying:=False; //開(kāi)中斷
exit; //退出
end;
// 確認(rèn)有變化
FWaitState:= Astate; //記住確認(rèn)的新?tīng)顟B(tài)WaitState 以便與常延時(shí)后進(jìn)行對(duì)照
FTimer.Enabled:=True;//開(kāi)啟常延時(shí)
DoLogEvent( '開(kāi)啟常延時(shí)');
end;
//常延時(shí) 到
procedure TPCI7233.OnExpTime(sender: TObject);
var aState :DWord; port:SmallInt;
begin
FTimer.Enabled:=False;//關(guān)閉常延時(shí)
DoLogEvent( '常延時(shí)到');
// 延時(shí)查詢進(jìn)行 常延時(shí)后 狀態(tài)確認(rèn)
Astate:= ReadPortEX( 100,5); //500ms
if Astate = FWaitState then begin // 確認(rèn)常延時(shí)后狀態(tài)與中斷確認(rèn)的狀態(tài)一致
RepeatCount:=0;
Port :=GetChangeBit(FWaitState); //判別是那個(gè)端口 發(fā)生 中斷
if assigned(FOnIntEvent) then// 最終確認(rèn)端口Port發(fā)生變化
FOnIntEvent(self,FWaitState,Port); //啟動(dòng)讀表程序
exit; //退出 至此，中斷仍處于阻斷狀態(tài)
// 確認(rèn)常延時(shí)后狀態(tài)與中斷確認(rèn)的狀態(tài) 不 一致
end else if Astate = FSaveState then begin //但與發(fā)生中斷之前的狀態(tài)一致
RepeatCount:=0;
DoLogEvent( '大干擾不需處理'); //認(rèn)為是 大干擾 不需處理
IntBusying:=False; //開(kāi)中斷
exit; //退出
end else begin // 常延時(shí)后確認(rèn)的狀態(tài) 確實(shí)發(fā)生變化（<> FSaveState ）
//但與中斷確認(rèn)的狀態(tài)WaitState 也不一致
//認(rèn)為是 中斷確認(rèn)出錯(cuò) 或 常延時(shí)后 查詢的狀態(tài)出錯(cuò) 或 7233卡有故障
IntBusying:=False; //開(kāi)中斷
if RepeatCount <2 then begin
inc( RepeatCount);
DoLogEvent( '意外出錯(cuò)，重新判別');
Test2;
exit;
end else begin
RepeatCount:=0;
DoLogEvent( '意外出錯(cuò)，退出'); // 怎么辦
//以失敗告終
//更新保存狀態(tài)
SaveState:= Astate;
exit; //退出
end;
end;
end;
procedure TPCI7233.SetOnOffChgColor(const Value: TColor);
begin
FOnOffChgColor := Value;
Repaint;
end;
function TPCI7233.SaveStateBit0(B1_32: byte): Boolean;
begin
end;
function TPCI7233.SaveStateBit1(B1_32: byte): Boolean;
begin
result:= _Bit1(FSaveState,B1_32 );
end;
function TPCI7233.ReadPortEX(SetpTime,SetpCount: Integer ): Dword;
var CNT:Integer; ErrCount:Word;
begin
CNT:=1; ErrCount :=0;
delay(SetpTime);
while CNT<SetpCount do begin
result :=ReadPort;
// form1.Memo1.Lines.Add(Inttostr(result)) ;
delay(SetpTime);
if (ReadPort<>result) then CNT:=1 else CNT:=CNT+1;
inc(ErrCount);
if ErrCount > 200 then begin result:=FsaveState; exit;end;
end;
end;
procedure TPCI7233.SetWaitTime(const Value: Integer);
begin
FWaitTime := Value;
FTimer.Interval:=FWaitTime ;
end;
procedure TPCI7233.Test2;
var msg:Tmessage;
begin
msg.Msg:= INTAccessMsg;
OnCall(msg);
end;
procedure TPCI7233.DoLogEvent(msg: string);
begin
if assigned(FOnLogEvent) then FOnLogEvent(self,msg);
end;
end.
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -