testcontrol.pas

合成实验的上位机程序

end;

function TTestControlForm.Bit_Byte(Bit: Byte): Byte;
var
  i: Byte;
begin
  Result:=1;
  for i:=1 to Bit do Result:=Result*2;
end;

function TTestControlForm.Bit_Word(Bit: Byte): Word;
var
  i: Byte;
begin
  Result:=1;
  for i:=1 to Bit do Result:=Result*2;
end;

function TTestControlForm.CButtonColor(channel: Byte): Integer;
begin
  Result:=clSilver;
  case ControlC[channel] of
    0:Result:=clSilver;
    1:Result:=clRed;
    2:Result:=clMaroon;
    3:Result:=clLime;
    4:Result:=clGreen;
  end;
end;

procedure TTestControlForm.Button2Click(Sender: TObject);
var
  I:integer;
  tmp: Integer;
  hSnapshot: THandle;
  lppe: TProcessEntry32;
  Found: Boolean;
  tChannel,tTime: Integer;
  port,data: Byte;
begin
  ScreenDisplay;
  TestStatus:=true;
  ReadPara;
  MyQuit:=false;
  My_Test:=true;
  OPortData[5]:=(OPortData[5])or($01);
  OPortData[5]:=(OPortData[5])and($0fd);
  ControlC[33]:=3;ControlC[34]:=4;
  TestControlForm.Button1.Enabled:=false;
  TestControlForm.Button2.Enabled:=false;
  TestControlForm.Button3.Enabled:=false;
  tChannel:=ParaAddFrm.ComboBox3.ItemIndex+1;
  try
    tTime:=StrToInt(ParaAddFrm.Edit4.Text)*10;
  except
    if MessageBox(TestControlForm.Handle,'预留半波必须为整数!', '错误', MB_OK+MB_ICONERROR)=IDOK then
      Exit;
  end;
  hSnapShot:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  Found:=Process32First(hSnapshot,lppe);
  while Found do
    if UpperCase(ExtractFileName(lppe.szExeFile))='TEST.EXE' then
    begin
      SetPriorityClass(hSnapshot,REALTIME_PRIORITY_CLASS);
      Break;
    end
    else
      Found:=Process32Next(hSnapshot,lppe);
  port:=(tChannel-1)div(8)+1;data:=Bit_Byte((tChannel-1)mod(8));
  OPortData[port]:=OPortData[port]or(data);
  PIO_Initial;
  PIO_Write;
  sleep(tTime);
  TestControl;
  OPortData[port]:=OPortData[port]and(not(data));
  PIO_Write;
  SetPriorityClass(hSnapshot,NORMAL_PRIORITY_CLASS);
  CloseHandle(hSnapshot);

  TestControlForm.Button1.Enabled:=true;
  TestControlForm.Button2.Enabled:=false;
  TestControlForm.Button3.Enabled:=false;
  ScreenDisplay;
  Label37.Tag:=Label37.Tag+1;
  Label37.Caption:=IntToStr(Label37.Tag);
  for I:=1 to 40 do
    if cnnConImg[I].Tag=99 then
    begin
      cnnConImg[I].Picture.LoadFromFile(Main.PictureDir+'Red.bmp');
      cnnVerImg[I].Picture.LoadFromFile(Main.PictureDir+'Red.bmp');
    end;
  for I:=1 to 4 do
  begin
    cnnHighImg[I].Picture.LoadFromFile(Main.PictureDir+'Red.bmp');
    cnnArcImg[I].Picture.LoadFromFile(Main.PictureDir+'Red.bmp');
  end;
end;

procedure TTestControlForm.TestControl;
label 10,20;
var
  channel: Byte;
  PCTC_Order:array[1..12] of Byte;
  Level_init:array[1..12] of Boolean;
  EndStatus,value: Boolean;
  En,Fn: Word;
  J: Integer;
begin
  J:=0;
  TestStart(35);
  KS_Control;
  for channel:=1 to ChannelCount do
  begin
    PCTC_Order[channel]:=1;
    level_init[channel]:=false;
    if CTC_End[channel]=false then
    begin
      if CTC_Order[channel]>0 then
      begin
        CalculatePortData(channel);
        PCTC_Time(channel);
      end;
    end;
  end;
  asm
    mov dx,0cc14h
    mov ax,&CTC_En
    out dx,ax
  end;//启动定时器
  PIO_Write;//输出控制信号
10:
{  for channel:=1 to ChannelCount do
  begin
    value:=PIO_ReadChannel_CTC(channel);
    if value<>level_init[channel] then
    begin
      time[PCTC_Order[channel],channel]:=PCTC_init[channel]-PCTC_Read(channel);
      if time[PCTC_Order[channel],channel]<0 then
        time[PCTC_Order[channel],channel]:=$10000+time[PCTC_Order[channel],channel];
      level_init[channel]:=value;
      inc(PCTC_Order[channel]);
    end;
  end;}
  asm
    mov dx,0cc14h
    in ax,dx
    and ax,&CTC_En
    mov &En,ax
  end;
  if En=0 then goto 10;//检查定时器是否溢出中断
  EndStatus:=true;

  inc(J);

  for channel:=1 to ChannelCount do
  begin
    if CTC_End[channel]=false then if PCTC_EndStatus(channel)=true then
    begin
      PIO_WriteB(channel);
    end;
    EndStatus:=(EndStatus)and(CTC_End[channel]);
  end;
//  if J>5 then goto 20;
  if EndStatus=false then goto 10;
20:
  CalculateInChannelTime;
  OPortData[5]:=OPortData[5]and($fc);
  ControlC[33]:=4;ControlC[34]:=4;
  PIO_Write;
end;

procedure TTestControlForm.CalculateInChannelTime;
begin

end;

procedure TTestControlForm.PIO_Initial;
begin
  asm
    mov dx,0ac00h
    mov al,01h
    out dx,al
    add dx,0c8h
    mov al,38h
    out dx,al
    add dx,04h
    out dx,al
    mov dx,0acd0h
    mov al,02h
    out dx,al
  end;
end;

procedure TTestControlForm.PIO_Write;
var
  i,j,k,l,m: Byte;
begin
  i:=OPortData[1];
  j:=OPortData[2];
  k:=OPortData[3];
  l:=OPortData[4];
  m:=OPortData[5];
  asm
    mov dx,0acc4h
    mov al,0h
    out dx,al
    sub dx,04h
    mov al,&i
    out dx,al//输出1~8
    add dx,04h
    mov al,01h
    out dx,al
    sub dx,04h
    mov al,&j
    out dx,al//输出9~16
    add dx,04h
    mov al,06h
    out dx,al
    sub dx,04h
    mov al,&k
    out dx,al//输出17~24
    add dx,04h
    mov al,07h
    out dx,al
    sub dx,04h
    mov al,&l
    out dx,al//输出25~32
    add dx,04h
    mov al,02h
    out dx,al
    sub dx,04h
    mov al,&m
    out dx,al//输出33~36
  end;
end;

function TTestControlForm.PIO_ReadChannel_IO(channel: Byte): Boolean;
var
  port,data: Byte;
begin
  data:=Bit_Byte((channel-1)mod(8));
  case (channel-1)div(8) of
    0:port:=3;
    1:port:=4;
    2:port:=9;
    3:port:=10;
    4:port:=5;
  end;
  asm
    mov dx,0acc4h
    mov al,port
    out dx,al
    sub dx,04h
    in al,dx
    and al,data
    mov &data,al
  end;
  if data=0 then result:=false else result:=true;
end;

function TTestControlForm.PIO_ReadChannel_CTC(channel: Byte): Boolean;
var
  port,data: Byte;
begin
  data:=CTC_Address[2,channel];
  case CTC_Address[1,channel] of
    0:port:=3;
    1:port:=4;
    2:port:=9;
    3:port:=10;
    4:port:=5;
  end;
  asm
    mov dx,0acc4h
    mov al,port
    out dx,al
    sub dx,04h
    in al,dx
    and al,data
    mov &data,al
  end;
  if data=0 then result:=false else result:=true;
end;

procedure TTestControlForm.PIO_WriteB(channel: Byte);
label 10;
begin
    if CTC_Order[channel]=0 then CTC_Level[1,channel]:=false;
    CalculatePortData(channel);
    PIO_Write;
    if CTC_Order[channel]=0 then begin
      CTC_End[channel]:=true;
      goto 10;
    end;
    PCTC_Time(channel);
    PCTC_On;
    dec(CTC_Order[channel]);
10:
end;

procedure TTestControlForm.ScreenDisplay;
begin
  shape1.Brush.Color:=CButtonColor(1);
  shape2.Brush.Color:=CButtonColor(2);
  shape3.Brush.Color:=CButtonColor(3);
  shape4.Brush.Color:=CButtonColor(4);
  shape5.Brush.Color:=CButtonColor(5);
  shape6.Brush.Color:=CButtonColor(6);
  shape7.Brush.Color:=CButtonColor(7);
  shape8.Brush.Color:=CButtonColor(8);
  shape9.Brush.Color:=CButtonColor(9);
  shape10.Brush.Color:=CButtonColor(10);
  shape11.Brush.Color:=CButtonColor(11);
  shape12.Brush.Color:=CButtonColor(12);
  shape13.Brush.Color:=CButtonColor(13);
  shape14.Brush.Color:=CButtonColor(14);
  shape15.Brush.Color:=CButtonColor(15);
  shape16.Brush.Color:=CButtonColor(16);
  shape17.Brush.Color:=CButtonColor(17);
  shape18.Brush.Color:=CButtonColor(18);
  shape19.Brush.Color:=CButtonColor(19);
  shape20.Brush.Color:=CButtonColor(20);
  shape21.Brush.Color:=CButtonColor(21);
  shape22.Brush.Color:=CButtonColor(22);
  shape23.Brush.Color:=CButtonColor(23);
  shape24.Brush.Color:=CButtonColor(24);
  shape25.Brush.Color:=CButtonColor(25);
  shape26.Brush.Color:=CButtonColor(26);
  shape27.Brush.Color:=CButtonColor(27);
  shape28.Brush.Color:=CButtonColor(28);
  shape29.Brush.Color:=CButtonColor(29);
  shape30.Brush.Color:=CButtonColor(30);
  shape31.Brush.Color:=CButtonColor(31);
  shape32.Brush.Color:=CButtonColor(32);
  shape33.Brush.Color:=CButtonColor(33);
  shape34.Brush.Color:=CButtonColor(34);
  shape35.Brush.Color:=CButtonColor(35);
  shape36.Brush.Color:=CButtonColor(36);
end;

procedure TTestControlForm.Button3Click(Sender: TObject);
var
  I:integer;
  tmp: Integer;
  hSnapshot: THandle;
  lppe: TProcessEntry32;
  Found: Boolean;
  tChannel,tTime: Integer;
  port,data: Byte;
begin
  ScreenDisplay;
  ReadPara;
  TestStatus:=False;
  MyQuit:=false;
  My_Test:=true;
  OPortData[5]:=(OPortData[5])or($02);
  OPortData[5]:=(OPortData[5])and($0fe);
  ControlC[33]:=4;ControlC[34]:=3;
  TestControlForm.Button1.Enabled:=false;
  TestControlForm.Button2.Enabled:=false;
  TestControlForm.Button3.Enabled:=false;
  tChannel:=ParaAddFrm.ComboBox3.ItemIndex+1;
  try
    tTime:=StrToInt(ParaAddFrm.Edit4.Text)*10;
  except
    if MessageBox(TestControlForm.Handle,'预留半波必须为整数!', '错误', MB_OK+MB_ICONERROR)=IDOK then
      Exit;
  end;
  hSnapShot:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  Found:=Process32First(hSnapshot,lppe);
  while Found do
    if UpperCase(ExtractFileName(lppe.szExeFile))='TEST.EXE' then
    begin
      SetPriorityClass(hSnapshot,REALTIME_PRIORITY_CLASS);
      Break;
    end
    else
      Found:=Process32Next(hSnapshot,lppe);
  port:=(tChannel-1)div(8)+1;data:=Bit_Byte((tChannel-1)mod(8));
  OPortData[port]:=OPortData[port]or(data);
  PIO_Initial;
  PIO_Write;
  sleep(tTime);
  TestControl;
  OPortData[port]:=OPortData[port]and(not(data));
  PIO_Write;
  SetPriorityClass(hSnapshot,NORMAL_PRIORITY_CLASS);
  CloseHandle(hSnapshot);

  TestControlForm.Button1.Enabled:=true;
  TestControlForm.Button2.Enabled:=false;
  TestControlForm.Button3.Enabled:=false;
  ScreenDisplay;
end;

procedure TTestControlForm.Button1Click(Sender: TObject);
begin
  asm
    mov dx,0ac00h
    mov al,01h
    out dx,al
    mov dx,0acc4h
    mov al,0ch
    out dx,al
    mov dx,0acd0h
    mov al,00h
    out dx,al
    mov dx,0acc0h
    mov al,0h
    out dx,al
   end;            
  ReadPara;
  KS:=0;
  shape46.Brush.Color:=clMaroon;
  shape47.Brush.Color:=clMaroon;
  shape48.Brush.Color:=clMaroon;
  shape49.Brush.Color:=clMaroon;
  shape50.Brush.Color:=clGreen;
  shape51.Brush.Color:=clGreen;
  shape52.Brush.Color:=clGreen;
  shape53.Brush.Color:=clGreen;
  ControlC[33]:=4;ControlC[34]:=4;
  Button1.Enabled:=false;
  Button2.Enabled:=true;
  Button3.Enabled:=true;
  ScreenDisplay;
end;

function TTestControlForm.QuitStatus: Boolean;
begin
  if MyQuit=true then QuitStatus:=true else QuitStatus:=false;
end;

procedure TTestControlForm.yh_on;
begin
  shape46.Brush.Color:=clRed;
  shape47.Brush.Color:=clRed;
  shape48.Brush.Color:=clRed;
  shape49.Brush.Color:=clRed;
  KS:=(KS)or($0f0);
  KS_Control;
end;

procedure TTestControlForm.yh_off;
begin
  shape46.Brush.Color:=clMaroon;
  shape47.Brush.Color:=clMaroon;
  shape48.Brush.Color:=clMaroon;
  shape49.Brush.Color:=clMaroon;
  KS:=(KS)and($0f);
  KS_Control;
end;

procedure TTestControlForm.gy_on;
begin
  shape50.Brush.Color:=clLime;
  shape51.Brush.Color:=clLime;
  shape52.Brush.Color:=clLime;
  shape53.Brush.Color:=clLime;
  KS:=(KS)or($0f);
  KS_Control;
end;

procedure TTestControlForm.gy_off;
begin
  shape50.Brush.Color:=clGreen;
  shape51.Brush.Color:=clGreen;
  shape52.Brush.Color:=clGreen;
  shape53.Brush.Color:=clGreen;
  KS:=(KS)and($0f0);
  KS_Control;
end;

procedure TTestControlForm.KS_Control;
begin
  asm
    mov dx,0acc4h
    mov al,0ch
    out dx,al
    sub dx,04h
    mov al,&KS
    out dx,al
  end;
end;

procedure TTestControlForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Button1.Enabled:=True;
  Button2.Enabled:=False;
  Button3.Enabled:=False;
end;

end.