⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 testcontrol.pas

📁 合成实验的上位机程序
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit TestControl;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Forms, TlHelp32,
  Dialogs, StdCtrls, ExtCtrls, Controls, TeEngine, Series, TeeProcs, Chart;

type
  TTestControlForm = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    Label21: TLabel;
    Label22: TLabel;
    Label23: TLabel;
    Label24: TLabel;
    Label25: TLabel;
    Label26: TLabel;
    Label27: TLabel;
    Label28: TLabel;
    Label29: TLabel;
    Label30: TLabel;
    Label31: TLabel;
    Label32: TLabel;
    Label66: TLabel;
    Label67: TLabel;
    Label69: TLabel;
    Label70: TLabel;
    Label71: TLabel;
    Label72: TLabel;
    Shape46: TShape;
    Shape47: TShape;
    Shape48: TShape;
    Shape49: TShape;
    Shape50: TShape;
    Shape51: TShape;
    Shape52: TShape;
    Shape53: TShape;
    Label33: TLabel;
    Label34: TLabel;
    Control1: TPanel;
    Shape1: TShape;
    Control2: TPanel;
    Shape2: TShape;
    Control3: TPanel;
    Shape3: TShape;
    Control4: TPanel;
    Shape4: TShape;
    Control5: TPanel;
    Shape5: TShape;
    Control6: TPanel;
    Shape6: TShape;
    Control7: TPanel;
    Shape7: TShape;
    Control8: TPanel;
    Shape8: TShape;
    Control9: TPanel;
    Shape9: TShape;
    Control10: TPanel;
    Shape10: TShape;
    Control11: TPanel;
    Shape11: TShape;
    Control12: TPanel;
    Shape12: TShape;
    Control13: TPanel;
    Shape13: TShape;
    Control14: TPanel;
    Shape14: TShape;
    Control15: TPanel;
    Shape15: TShape;
    Control16: TPanel;
    Shape16: TShape;
    Control17: TPanel;
    Shape17: TShape;
    Control18: TPanel;
    Shape18: TShape;
    Control19: TPanel;
    Shape19: TShape;
    Control20: TPanel;
    Shape20: TShape;
    Control21: TPanel;
    Shape21: TShape;
    Control22: TPanel;
    Shape22: TShape;
    Control23: TPanel;
    Shape23: TShape;
    Control24: TPanel;
    Shape24: TShape;
    Control25: TPanel;
    Shape25: TShape;
    Control26: TPanel;
    Shape26: TShape;
    Control27: TPanel;
    Shape27: TShape;
    Control28: TPanel;
    Shape28: TShape;
    Control29: TPanel;
    Shape29: TShape;
    control30: TPanel;
    Shape30: TShape;
    Control31: TPanel;
    Shape31: TShape;
    Control32: TPanel;
    Shape32: TShape;
    Button2: TButton;
    control33: TPanel;
    Shape33: TShape;
    control34: TPanel;
    Shape34: TShape;
    control35: TPanel;
    Shape35: TShape;
    control36: TPanel;
    Shape36: TShape;
    Label41: TLabel;
    Label42: TLabel;
    Label43: TLabel;
    Label44: TLabel;
    Button3: TButton;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Label35: TLabel;
    Label36: TLabel;
    Bevel1: TBevel;
    Label37: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure TestControl;
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ReadPara;
    procedure CalculatePortData(channel:Byte);
    procedure CTC_ParaCalculate;
    procedure PCTC_Load(channel,CTCH,CTCL: Byte);
    procedure PCTC_On;
    procedure PCTC_time(channel: Byte);
    procedure CSPortData;
    procedure PIO_Write;
    procedure PIO_Initial;
    procedure PIO_WriteB(channel: Byte);
    procedure CalculateInChannelTime;
    procedure TestStart(channel: Byte);
    procedure yh_on;
    procedure yh_off;
    procedure gy_on;
    procedure gy_off;
    procedure KS_Control;
    function CButtonColor(channel: Byte): Integer;
    function Bit_Byte(Bit: Byte): Byte;
    function Bit_Word(Bit: Byte): Word;
    function PCTC_EndStatus(channel: Byte): Boolean;
    function PCTC_Read(channel:Byte):Word;
    function PIO_ReadChannel_IO(channel: Byte): Boolean;
    function PIO_ReadChannel_CTC(channel: Byte): Boolean;
    function PeriodDetect(channel: Byte): Integer;
    function QuitStatus: Boolean;
    function Ver_Read(channel: Byte): Boolean;
    procedure ScreenDisplay;
  end;

var
  TestControlForm: TTestControlForm;
  ControlC:array[1..36] of Integer;
  Out_Select:array[1..36] of Boolean;
  CTC_Order:array[1..12] of Byte;
  CTC_Level:array[1..4,1..12] of Boolean;
  CTC_Time:array[1..4,1..12] of Integer;
  CTC_InTime: array[0..4,1..12] of Integer;
  CTC_InLevel: array[0..4,1..12] of Boolean;
  CTC_Address:array[1..3,1..12] of Byte;
  CTC_End:array[1..12] of Boolean;
  CTC_Para:array[1..4,1..12] of Byte;
  //定时器1~12的控制制
  PCTC_init:array[1..12] of Integer;
  OPortData:array[1..5] of Byte;
  SPortData:array[1..5] of Byte;
  time:array[1..5,1..12] of Integer;
  CTC_En: Word;
  MyQuit,My_Test: Boolean;
  KS,ChannelCount: Byte;
  TestStatus,PerStatus: Boolean;


implementation

uses ParaAdd, Main;

{$R *.dfm}

procedure TTestControlForm.FormCreate(Sender: TObject);
begin
  Label37.Tag:=0;
  Button1.Enabled:=true;
  Button2.Enabled:=false;
  Button3.Enabled:=false;
  ScreenDisplay;
end;

procedure TTestControlForm.ReadPara;
var
  i,j: Byte;
  tmp:String;
begin
  for i:=1 to 5 do OPortData[i]:=0;
  PIO_Write;
  for i:=1 to 32 do Out_Select[i]:=false;
  for i:=1 to 12 do
  begin
    CTC_Order[i]:=0;
    CTC_End[i]:=true;
    for j:=1 to 4 do
    begin
      CTC_Level[j,i]:=false;
      CTC_Time[j,i]:=0;
    end;
  end;
  for i:=1 to 12 do for j:=1 to 2 do Time[j,i]:=0;
  ParaAddFrm.ADOConnection1.Close;
  ParaAddFrm.ADOConnection1.Open;
  ParaAddFrm.ADODataSet1.Close;
  ParaAddFrm.ADODataSet1.Open;
  ParaAddFrm.ADODataSet1.First;
  ChannelCount:=0;
  for i:=1 to ParaAddFrm.ADODataSet1.RecordCount do
  begin
    tmp:=ParaAddFrm.ADODataSet1.FieldByName('通道序号').AsString;
    if length(tmp)=5 then
      j:=StrToInt(tmp[5])
    else
      if length(tmp)=6 then
        j:=StrToInt(tmp[5]+tmp[6])
      else
        if tmp='高压1~4' then
          j:=40
        else
          if tmp='延弧1~4' then
            j:=39;
    Out_Select[j]:=true;
    if ParaAddFrm.ADODataSet1.FieldByName('第一段电平类型').AsString='高' then CTC_Level[1,ChannelCount+1]:=true;
    if ParaAddFrm.ADODataSet1.FieldByName('第二段电平类型').AsString='高' then CTC_Level[2,ChannelCount+1]:=true;
    if ParaAddFrm.ADODataSet1.FieldByName('第三段电平类型').AsString='高' then CTC_Level[3,ChannelCount+1]:=true;
    if ParaAddFrm.ADODataSet1.FieldByName('第四段电平类型').AsString='高' then CTC_Level[4,ChannelCount+1]:=true;
    CTC_Time[1,ChannelCount+1]:=Trunc(ParaAddFrm.ADODataSet1.FieldByName('第一段脉冲宽度(ms)').AsFloat);
    CTC_Time[2,ChannelCount+1]:=Trunc(ParaAddFrm.ADODataSet1.FieldByName('第二段脉冲宽度(ms)').AsFloat);
    CTC_Time[3,ChannelCount+1]:=Trunc(ParaAddFrm.ADODataSet1.FieldByName('第三段脉冲宽度(ms)').AsFloat);
    CTC_Time[4,ChannelCount+1]:=Trunc(ParaAddFrm.ADODataSet1.FieldByName('第四段脉冲宽度(ms)').AsFloat) div 2;
    inc(CTC_Order[ChannelCount+1]);
    CTC_Address[1,ChannelCount+1]:=(j-1)div(8);
    CTC_Address[3,ChannelCount+1]:=(j-1)mod(8);
    CTC_Address[2,ChannelCount+1]:=Bit_Byte(CTC_Address[3,ChannelCount+1]);
    CTC_End[ChannelCount+1]:=false;
    ParaAddFrm.ADODataSet1.Next;
    inc(ChannelCount);
  end;
  for i:=1 to 32 do if Out_Select[i]=false then ControlC[i]:=0 else ControlC[i]:=2;
  for i:=1 to 12 do
  begin
    for j:=2 to 4 do
    begin
      if CTC_Time[j,i]=0 then CTC_Level[j,i]:=false;
    end;
  end;
  for i:=1 to 12 do
  begin
    for j:=1 to 3 do if CTC_Level[j,i]<>CTC_Level[j+1,i] then inc(CTC_Order[i]);
  end;
  CSPortData;
  CTC_ParaCalculate;
end;

function TTestControlForm.PeriodDetect(channel: Byte): Integer;
label 10,20,30,40,50;
var
  i: Integer;
  Ia: Boolean;
begin
  PIO_Initial;
  result:=0;
  Ia:=PIO_ReadChannel_IO(channel);
  for i:=1 to 5000 do if PIO_ReadChannel_IO(channel)<>Ia then result:=1;
  if result=0 then goto 50;
  PCTC_Load(1,0,0);
10:
  if PIO_ReadChannel_IO(channel)=true then goto 10 else
  begin
20:
    if PIO_ReadChannel_IO(channel)=true then PCTC_on else goto 20;
30:
    if PIO_ReadChannel_IO(channel)=true then goto 30;
40:
    if PIO_ReadChannel_IO(channel)=false then goto 40 else result:=(256*256-PCTC_Read(1))*125;
  end;
50:
end;

procedure TTestControlForm.TestStart(channel: Byte);
label 10,20;
var
  Per_Status: Boolean;
  temp:variant;
begin
  if abs(2000000-PeriodDetect(channel))<500000 then Per_Status:=true;
  if My_Test=false then  Per_Status:=false;
  if Per_status=true then
  begin
10:
    if Ver_Read(35)=true then goto 10;
20:
    if Ver_Read(35)=false then goto 20;
  end;

end;

function TTestControlForm.Ver_Read(channel: Byte): Boolean;
label 10;
var
  Re_Status: Boolean;
  i: Byte;
begin
10:
  PerStatus:=true;
  Re_Status:=PIO_ReadChannel_IO(channel);
  for i:=1 to 2 do
    if Re_Status<>PIO_ReadChannel_IO(channel) then PerStatus:=false;
  result:=Re_Status;
end;


procedure TTestControlForm.CalculatePortData(channel:Byte);
var
  port,data,IO_channel: Byte;
begin
  IO_channel:=CTC_Address[1,channel]*8+CTC_Address[3,channel]+1;
  if IO_channel<33 then
  begin
    port:=CTC_Address[1,channel]+1;data:=CTC_Address[2,channel];
    if CTC_Level[1,channel]=false then
      OPortData[port]:=OPortData[port]and(not(data))
    else
      OPortData[port]:=OPortData[port]or(data);
    if CTC_Level[1,channel]=false then ControlC[IO_channel]:=2 else ControlC[IO_channel]:=1;
  end
  else begin
    if IO_channel=39 then if CTC_Level[1,channel]=false then yh_off else yh_on;
    if IO_channel=40 then if CTC_Level[1,channel]=false then gy_off else gy_on;
  end;
  for port:=1 to 3 do CTC_Level[port,channel]:=CTC_Level[port+1,channel];
end;

procedure TTestControlForm.CSPortData;
var
  i,port,data: Byte;
begin
  for i:=1 to 5 do SPortData[i]:=0;
  for i:=1 to 12 do
  begin
    port:=CTC_Address[1,i]+1;data:=CTC_Address[2,i];
    SPortData[port]:=SPortData[port]or(data);
  end;
end;

//计算定时器1~12的寄存器地址和控制字//
procedure TTestControlForm.CTC_ParaCalculate;
var
  i: Byte;
begin
  for i:=1 to 12 do
  begin
    CTC_Para[1,i]:=(i-1)div(3);//芯片
    CTC_Para[2,i]:=(i-1)mod(3)*4;//数据寄存器
    CTC_Para[3,i]:=($30)or(CTC_Para[2,i]*16);//控制制
  end;
  CTC_En:=0;
end;

procedure TTestControlForm.PCTC_time(channel: Byte);
var
  CTCH,CTCL: Byte;
  timer: Integer;
begin
  timer:=CTC_Time[1,channel]*8;
  CTC_Para[4,channel]:=(timer)div($10000);
  CTCL:=((timer)mod($10000))mod($100);
  CTCH:=((timer)mod($10000))div($100);
  PCTC_init[channel]:=(timer)mod($10000);
  PCTC_Load(channel,CTCH,CTCL);
  for timer:=1 to 3 do CTC_Time[timer,channel]:=CTC_Time[timer+1,channel];
end;

procedure TTestControlForm.PCTC_Load(channel,CTCH,CTCL: Byte);
var
  chip,counter,model: Byte;
  En: Word;
begin
  chip:=CTC_Para[1,channel];
  counter:=CTC_Para[2,channel];
  model:=CTC_Para[3,channel];
  En:=CTC_En and (not(Bit_Word(channel-1)));
  CTC_En:=CTC_En or (Bit_Word(channel-1));
  asm
    mov dx,0cc14h
    mov ax,&En
    out dx,ax//关定时器
    sub dx,04h
    mov al,&chip//选择芯片
    out dx,al
    sub dx,04h
    mov al,&model
    out dx,al//设置工作方式
    sub dx,0ch
    mov al,&counter
    mov ah,0h
    add dx,ax
    mov al,&CTCL
    out dx,al//加载时间常数低位
    mov al,&CTCH
    out dx,al//加载时间常数高位
  end;
end;

procedure TTestControlForm.PCTC_On;
begin
  asm
    mov dx,0cc14h
    mov ax,&CTC_En
    out dx,ax
  end;
end;

function TTestControlForm.PCTC_EndStatus(channel: Byte): Boolean;
var
  gateB: Word;
begin
  asm
    mov dx,0cc14h
    in ax,dx
    mov &gateB,ax
  end;
  gateB:=gateB and Bit_Word(channel-1);
  if gateB=0 then Result:=false else
  begin
    if CTC_Para[4,channel]=0 then  Result:=true else
    begin
      Result:=false;
      dec(CTC_Para[4,channel]);
      PCTC_Load(channel,0,0);
      PCTC_On;
    end;
  end;
end;

function TTestControlForm.PCTC_Read(channel: Byte): Word;
var
  chip,counter: Byte;
begin
  chip:=CTC_Para[1,channel];
  counter:=CTC_Para[2,channel];
  asm
    mov dx,0cc10h
    mov al,&chip
    out dx,al
    sub dx,10h
    mov al,&counter
    add dx,ax
    in al,dx
    mov bl,al
    in al,dx
    mov ah,al
    mov al,bl
    mov &result,ax
  end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -