pci7233.pas

PCI7233接口板采集模块,可直接实现数字IO的采集,支持中断方式

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 SaveState: DWord read  FSaveState  write  SetSaveState;
    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('更新状态为%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;  //阻断中断响应

  IntBusying:=True; //关中断响应

       // 延时查询进行中断确认
  Astate:=  ReadPortEX( 100,10);
  DoLogEvent( format('中断响应到：确认状态= %x',[aState]));
  if  Astate = FSaveState then begin   // 中断确认无变化= FSaveState
     IntBusying:=False;  //开中断
     exit;              //退出
  end;
       // 确认有变化
  FWaitState:= Astate;  //记住确认的新状态WaitState  以便与常延时后进行对照
  FTimer.Enabled:=True;//开启常延时
  DoLogEvent( '开启常延时');
end;
  //常延时 到
procedure TPCI7233.OnExpTime(sender: TObject);
 var  aState :DWord; port:SmallInt;
begin
  FTimer.Enabled:=False;//关闭常延时
  DoLogEvent( '常延时到');

       // 延时查询进行  常延时后   状态确认
  Astate:=  ReadPortEX( 100,5);   //500ms
  if  Astate = FWaitState then begin   // 确认常延时后状态与中断确认的状态一致
      RepeatCount:=0;
      Port :=GetChangeBit(FWaitState);  //判别是那个端口 发生 中断
      if assigned(FOnIntEvent) then// 最终确认端口Port发生变化
           FOnIntEvent(self,FWaitState,Port);  //启动读表程序
     exit;   //退出  至此，中断仍处于阻断状态

      // 确认常延时后状态与中断确认的状态  不 一致
  end else if   Astate = FSaveState  then begin  //但与发生中断之前的状态一致
     RepeatCount:=0;
     DoLogEvent( '大干扰不需处理');     //认为是 大干扰  不需处理
     IntBusying:=False;  //开中断
     exit;              //退出
  end  else begin  // 常延时后确认的状态 确实发生变化（<> FSaveState ）
                   //但与中断确认的状态WaitState 也不一致
       //认为是 中断确认出错 或 常延时后 查询的状态出错 或 7233卡有故障
     IntBusying:=False;  //开中断        
     if  RepeatCount <2 then begin
           inc( RepeatCount);
           DoLogEvent( '意外出错，重新判别');
           Test2;
           exit;
     end else begin
          RepeatCount:=0;
          DoLogEvent( '意外出错，退出');  // 怎么办
                    //以失败告终
                    //更新保存状态
          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
  result:= _Bit0(FSaveState,B1_32  );
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.