{--------------- Программа LPT SEND : смотрим код ---------------}


 {Универсальный переключатель - используйте в своих программах}     
function TForm1.Bits : boolean ; //--отслеживает переключения бит
(1-2-4-8-16-32-64-128)
Var
d : boolean;
bit : byte;
begin
bit := StrToInt(ComboBox3.Text); //-- переключатель бит (согласно отдельно
взятому Pin)
d := true; {and - не инвертируется }
d := d and ((bit) = ((bit) and Lpt.ReadPort(GetCurrentPort,GetCurrentRegister)))
;
{Предусмотр. автоматическая инверсия инверсных бит рег. контроля - это: Pin1,
Pin14, Pin17}
if (ComboBox2.Text = 'КОНТРОЛЯ')  then
if (bit = 1) or (bit = 2) or (bit = 8)then d := not d ; //-- "or" - значит "или"
{Предусмотр. автоматическая инверсия инверсных бит входного рег. - это: Pin11}
if (ComboBox2.Text = 'ВХОДЫ')  then
if (bit = 128) then d := not d ;
{ если выбран инверсный режим - инвертируем вручную всё}
if CheckBox1.Checked = true then d := not d ;
Bits := d;
end;



function TForm1.CLK : boolean ; //-- позволяет инвертировать сигнал CLK
Var
d : boolean;
b : integer;
begin
b := StrToInt(ComboBox5.Text); //-- установка бита
d := true;
d := d and (b  = (b  and Lpt.ReadPort(GetCurrentPort,2))) ;
if CheckBox3.Checked = false then CLK := d else CLK := not d;
end;




procedure TForm1.Timer1Timer(Sender: TObject);  //-- таймер индикации
begin
SpeedButton1.Enabled := Bits;  //-- управляем контрольным светодиодом
(встроенный в SpeedButton1)
SpeedButton3.Enabled := CLK; //-- управляем контрольным светодиодом CLK
if CLK = false then
begin
SpeedButton6.Enabled := (CLK xor Bits) or (CLK and Bits) ; //-- зажигаем если
неправильно настроенны биты RX
end;
end;



 
{Добавлена полезная проц. PinInfo, информ. о структуре LPT регистров и соотв.Pin}
procedure TForm1.PinInfo ;
begin
if ComboBox2.Text = 'ДАННЫХ' then
begin
 if ComboBox3.Text = '1' then StaticText1.Caption := ' Bit 2* = 1 :      Pin2';
 if ComboBox3.Text = '2' then StaticText1.Caption := ' Bit 2* = 2 :      Pin3';
 if ComboBox3.Text = '4' then StaticText1.Caption := ' Bit 2* = 4 :      Pin4';
 if ComboBox3.Text = '8' then StaticText1.Caption := ' Bit 2* = 8 :      Pin5';
 if ComboBox3.Text = '16' then StaticText1.Caption := ' Bit 2* = 16 :    Pin6';
 if ComboBox3.Text = '32' then StaticText1.Caption := ' Bit 2* = 32 :    Pin7';
 if ComboBox3.Text = '64' then StaticText1.Caption := ' Bit 2* = 64 :    Pin8';
 if ComboBox3.Text = '128'then StaticText1.Caption := ' Bit 2* = 128 :   Pin9';
end;

if ComboBox2.Text = 'КОНТРОЛЯ' then
begin
 if ComboBox3.Text = '1' then StaticText1.Caption := ' Bit 2* = 1 :     Pin1'
else
 if ComboBox3.Text = '2' then StaticText1.Caption := ' Bit 2* = 2 :     Pin14'
else
 if ComboBox3.Text = '4' then StaticText1.Caption := ' Bit 2* = 4 :     Pin16'
else
 if ComboBox3.Text = '8' then StaticText1.Caption := ' Bit 2* = 8 :     Pin17'
else
 StaticText1.Caption := ' Не поддерживает ' ;
end;

if ComboBox2.Text = 'ВХОДЫ' then
begin
 if ComboBox3.Text = '8'  then StaticText1.Caption := ' Bit 2* = 8:     Pin15'
else
 if ComboBox3.Text = '16' then StaticText1.Caption := ' Bit 2* = 16:    Pin13'
else
 if ComboBox3.Text = '32' then StaticText1.Caption := ' Bit 2* = 32:    Pin12'
else
 if ComboBox3.Text = '64' then StaticText1.Caption := ' Bit 2* = 64:    Pin10'
else
 if ComboBox3.Text = '128'then StaticText1.Caption := ' Bit 2* = 128:   Pin11'
else
 StaticText1.Caption := ' Не поддерживает ' ;
end;

end;



procedure TForm1.ComboBox3Change(Sender: TObject);
begin
PinInfo; //-- вызываем процедуру при переключении бит
end;

procedure TForm1.ComboBox2Change(Sender: TObject);
begin
PinInfo; //-- вызываем процедуру при переключении регистров
end;







procedure TForm1.SpeedButton2Click(Sender: TObject); //-- кнопка "передача"
begin

Edit1.Text := '0'; //-- обновить индикатор
TX;  //-- включ. передачу
end;



procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); //-- прерываем циклы
begin
StopRX := true;
StopTX := true;
end;

 {Внешний высокоскоростной приёмник "RX2" (Запустите вторую копию программы )}
 procedure TForm1.RX2; //-- режим приёмника 2
 Var
 a : integer;
 begin
 Edit3.Text := '0';
 StopRX := false;  //--флаг стоп / старт
 While not StopRX do //--бесконечный цикл, пока флаг стоп не поднят:
 begin
 a := 0;
 { -------------- Счётчик импульсов1 (Биты задаются Bits )--------------}
 if Edit3.Tag = 0 then  //-- TAG = 0 : метка начала отсчета
 begin
 if Bits = true then
 begin //-- собственно счётчик
 a := a + 1;  //-- фиксируем импульс
 Edit3.Text := IntToStr(StrToInt(Edit3.Text)+1); // -- принимаем импульсы
 end;
 Edit3.Tag :=1; //-- TAG = 1 : метка конца отсчета
 if a = 1 then ButtonPin2; // -- подтверждаем приём импульса, с помощью Рin2
 end;
 if Bits = false then Edit3.Tag := 0; //-- разреш. отсчёт след. импульса

 { -------------- Счётчик импульсов2 <CLK> (Pin16 )--------------------------}
 if Edit4.Tag = 0 then
 begin
 if CLK = true then Edit4.Text := IntToStr(StrToInt(Edit4.Text)+1);
 Edit4.Tag :=1;
 end;
 if CLK = false then Edit4.Tag := 0;
 { --------------------------------------------------------------------------}
 Sleep(TrackBar1.Position); //--приложение засыпает на заданный интервал
 Application.ProcessMessages; //--Обработка всей очереди сообщений
 end;
 end;

procedure TForm1.SpeedButton4Click(Sender: TObject); //-- кнопка "СТОП" передачи
Var
  a,b : integer;
  begin
  if SpeedButton4.Tag = 0 then //-- если кнопка не заблокирована тогда:
  begin
  a := StrToInt(Edit1.Text) ; //-- преобразуем
  b := StrToInt(Edit2.Text) ; //-- преобразуем
  StopTX := not StopTX; //-- "СТОП" передачи
  Edit2.Text := IntToStr(b-a); //-- устан. оставш. число для послед. передачи
  SpeedButton4.Tag := 1; //-- заблокировать дальнейшее применения кнопки
  end else MessageBeep(MB_ICONEXCLAMATION);
end;



 procedure TForm1.Timer3Timer(Sender: TObject); //-- таймер сброса и ведения LOG
 begin
 if CLK = false then //-- добавляем лог
 begin
 RichEdit1.Lines.Add (FormatDateTime('hh:mm:ss', time()) +' Принят код ' +
Edit3.Text);
 Edit3.Text := '0';
 Timer3.Enabled := false;
 end;
 end;


procedure TForm1.Edit4Change(Sender: TObject);
begin
  Timer3.Enabled := true; //-- таймер сброса и ведения LOG - включить
end;



  procedure TForm1.TX; //-- Передатчик последовательных импульсов Pin14
  Var
  a,b,c,d, i : integer;
  begin
  { автоматич. конролир. настройки бит по умолчанию }
  if CheckBox4.Checked = true then
  begin
  if Pin16 = true then ButtonPin16;
  if Pin14 = false then ButtonPin14;
  if Pin2  = true then ButtonPin2;
  end;
  {Собственно передатчик импульсов}
  d := 0 ;
  Timer2.Enabled := false ; //-- отключ. таймер после автокоррекции
  Edit1.Text := '0'; //-- обновить индикатор
  Edit6.Text := '0';  //-- обновляем
  SpeedButton4.Tag := 0;  //-- разрешаем кнопку "Стоп"
  a := StrToInt(Edit1.Text) ; //-- преобразуем
  b := StrToInt(Edit2.Text) ; //-- преобразуем
  c := StrToInt(ComboBox4.Text); //-- преобразуем
  Gauge1.MaxValue := b;  //-- настраиваем индикатор передачи (в %)
  Gauge1.ForeColor := clBlue; //-- показ.
  StopTX := false ; //-- флаг стоп / старт
  for i:= 1 to b*2 do  //-- цикл передачи (Внимание : задаётся Edit2 !)
  begin
  if StopTX = true then exit; //-- если наж. "Стоп" - прекращаем передачу
  ButtonPin14; //-- начинаем передачу импульсов Pin14 (передача 1 / 0)
  if Pin14 = true then a := a + 1; // -- контроль (подсчёт) переданных данных
  (лог. 1)
  Edit1.Text:= IntToStr(a); //-- выводим результ. подсчёта
  Gauge1.Progress := a;  //-- показ. переданное в %
  {Передаём сигнал управления CLK - лог. 1}
  Lpt.WritePort (GetCurrentPort,2,(c or Lpt.ReadPort( (GetCurrentPort) ,2) ));
  if a = b then //-- если цикл пройден :
  begin
  {Снимаем сигнал управления CLK - xor лог. 1 = 0}
  Lpt.WritePort (GetCurrentPort,2,(c xor Lpt.ReadPort( (GetCurrentPort) ,2) ));
  Gauge1.ForeColor := clScrollBar; //-- убираем отработ. проценты индикатора ТХ
  end;
  {Используем повтор передачи, снижая скорость автоматически если ошибка приёма}
  if  CheckBox2.Checked = true then //-- вкл. автокоррекцию скорости передачи
  begin
  if Pin2 = true then //-- считаем ипульсы подтверждения приёма
  begin
  Edit6.Text := IntToStr(StrToInt(Edit6.Text)+1); //-- счётчик импульсов
  d := StrToInt(Edit6.Text); //-- преобразуем и присваиваем
  end;
  {Если цикл передачи окончен, сигнал упр. отключён}
  if CLK = false then
  if (d <> a) and( d <> b)  then //-- если данные не совпадают:
  begin  {Увеличиваем задержку - уменьшаем скорость ТХ посылок}
  TrackBar2.Position := TrackBar2.Position + 15 ; //-- на нужное значение
  Label7.Caption := 'Контроль  Данные  Бит CLK     Управление      Задержка : '+
  IntToStr(TrackBar2.Position); //-- выводим значение задержки
  Timer2.Enabled := true; //-- вкл. таймер повтора ТХ
  end  else
  begin  //-- если данные совпали - отключаем систему
  beep;
  Edit6.Text := '0';
  if d = b then Timer2.Enabled := false;
  end;
  end;
  Sleep(TrackBar2.Position); //--приложение засыпает на заданный интервал
  Application.ProcessMessages; //--Обработка всей очереди сообщений
  end;
  end;



 {Простой внутренний контрольный приёмник "RX1"}
 procedure TForm1.Timer4Timer(Sender: TObject);
 Var
 a : integer;
 begin
 a := 0;
 { -------------- Счётчик импульсов1 (Биты задаются Bits )--------------}
 if Edit3.Tag = 0 then  //-- TAG = 0 : метка начала отсчета
 begin
 if Bits = true then
 begin //-- собственно счётчик
 a := a + 1;  //-- фиксируем импульс
 Edit3.Text := IntToStr(StrToInt(Edit3.Text)+1); // -- принимаем импульсы
 end;
 Edit3.Tag :=1; //-- TAG = 1 : метка конца отсчета
 if a = 1 then ButtonPin2; // -- подтверждаем приём импульса, с помощью Рin2
 end;
 if Bits = false then Edit3.Tag := 0; //-- разреш. отсчёт след. импульса

 { -------------- Счётчик импульсов2 (CLK )----------------------------}
 if Edit4.Tag = 0 then
 begin
 if CLK = true then Edit4.Text := IntToStr(StrToInt(Edit4.Text)+1);
 Edit4.Tag :=1;
 end;
 if CLK = false then Edit4.Tag := 0;
 { ---------------------------------------------------------------------}
 end;


procedure TForm1.RadioButton1Click(Sender: TObject); //-- переключатель RX1
begin
Timer4.Enabled := true;
StopRX := true;
Edit3.Text := '0';
end;

procedure TForm1.RadioButton2Click(Sender: TObject); //-- переключатель RX2
begin
Timer4.Enabled := false;
RX2;
Edit3.Text := '0';
end;

procedure TForm1.RadioButton3Click(Sender: TObject); //-- переключатель OFF
begin
Timer4.Enabled := false;
StopRX := true;
Edit3.Text := '0';
end;

procedure TForm1.TrackBar1Change(Sender: TObject); //-- показ задержки
begin
if TrackBar1.Position = 0 then Edit3.Color := clyellow else
Edit3.Color :=  clInfoBk;
Label6.Caption := 'Задержка  RX2  м.сек :  ' + IntTOStr(TrackBar1.Position);
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
 RichEdit1.Lines.SaveToFile('RX_Lod.txt');  //-- сохраняем в файл
end;

procedure TForm1.TrackBar2Change(Sender: TObject); //-- показ. задержку
begin
Label7.Caption := 'Контроль  Данные  Бит CLK     Управление       Задержка : '+
IntToStr(TrackBar2.Position);
end;


procedure TForm1.Timer2Timer(Sender: TObject);  //-- таймер повтора передачи
Var
b,d : integer;
begin
b := StrToInt(Edit2.Text) ; //-- преобразуем
d := StrToInt(Edit6.Text) ; //-- преобразуем
SpeedButton2.Click  ;
if (d = b)  then  //-- отключ. автоматически
Timer2.Enabled := false ;
end;



end.
 

end;

Cкачайте этот пример - primer_xp06.zip(30 kb)

Cкачать готовую программу - LPT SEND : lptsend.zip (207 kb)

****** Валерий Ковтун US4LEH http://valery-us4leh.narod.ru О сайте Вернуться на Шаг5. Системы автоматизации процессов: Digital Avto Tuning - программа автоматической подстройки кода Вернуться на XP LPT Вернуться на главную страницу Чтобы открыть ссылку в новом окне - удерживайте клавишу Shift Программа PortControl V3+ Программа PinRegistrator D1+ --> Гостевая книга --> Обратная связь

radionet