unit JanasCardu;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, CommInt, timer, StdCtrls, JanasCardModuleu;

type
  TJanasCardForm = class(TForm)
    Comm: TComm;
    Timer: TTimer;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    PrevodButton: TButton;
    OpenCloseButton: TButton;
    Label4: TLabel;
    Memo: TMemo;
    ClearLogButton: TButton;
    RadioGroup: TRadioGroup;
    ComNameEdit: TEdit;
    ModuleOpenStart: TButton;
    ModuleStopClose: TButton;
    procedure TimerTimer(Sender: TObject);
    procedure PrevodButtonClick(Sender: TObject);
    procedure OpenCloseButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ClearLogButtonClick(Sender: TObject);
    procedure RadioGroupClick(Sender: TObject);
    procedure ModuleOpenStartClick(Sender: TObject);
    procedure ModuleStopCloseClick(Sender: TObject);
  private
    FInTimer: boolean;
    { Private declarations }
    order: byte;
    vvv: byte;
    adresa: byte;
    hodnota: byte;
    vysledek: longint;

    FModule: TJanasCardModule;
    procedure Log(s: string);
  public
    { Public declarations }
    { Writes byte "outdata" to ADConverter, reads in one byte from the converter
      and returns it as a result of the function. }
    function janas(outdata: byte): byte;
  end;

var
  JanasCardForm: TJanasCardForm;

implementation

{$R *.dfm}


{*
Option Explicit

Dim order As Byte
Dim vvv As Byte
Dim adresa As Byte
Dim hodnota As Byte
Dim vysledek As Long

Function janas(outdata As Byte) As Byte
'zapisuje byte "outdata" do p5evodniku a nacita jeden byte dat z prevodniku,
' ktery vraci jako vysledek funkce

Dim i As Byte   ' pom. promenna pro realizaci cyklu
Dim delitel As Byte
Dim ven As Byte
Dim BDSR As Byte

Dim precteno As Byte

ven = outdata
delitel = 128
MSComm1.Output = Chr(0)   ' aktivuj CS vyslanim nuloveho bitu....
    While MSComm1.CDHolding = False ' ceka, az se bude realne vysilat, tj. CS aktivni
    Wend

    precteno = 0  'nuluj  snimaci hodnota


    For i = 0 To 7      'celkem 8 taktu hodin

        If (ven \ delitel) = 1 Then      ' data IN bit pripravit na linku... >> RTS <<
            MSComm1.RTSEnable = False
        Else
            MSComm1.RTSEnable = True
        End If
        ven = ven Mod delitel
        delitel = delitel \ 2
        MSComm1.DTREnable = False      ' clk = >> DTR <<  na log. 0, pocatek synchronizacniho pulsu...
        If (MSComm1.DSRHolding = True) Then     ' precti data OUT
            BDSR = 0
        Else
            BDSR = 1
        End If
        precteno = (precteno * 2) + BDSR
        MSComm1.DTREnable = True    ' clk = >> DTR <<  na log.1 , konec  synchronizacniho pulsu...
    Next i

 janas = precteno   ' hodnota pro navrat z funkce
End Function

Private Sub Command1_Click()
    Label4.Caption = janas(CByte(Text1.Text))
End Sub


Private Sub Command2_Click(Index As Integer)
If Index = 1 Then
    MSComm1.DTREnable = True
Else
    MSComm1.DTREnable = False
End If
End Sub

Private Sub Command3_Click(Index As Integer)
If Index = 1 Then
    MSComm1.RTSEnable = True
Else
    MSComm1.RTSEnable = False
End If

End Sub

Private Sub Form_Load()
    MSComm1.PortOpen = True
    MSComm1.DTREnable = True
    MSComm1.RTSEnable = False
    Timer1.Enabled = False
End Sub

Private Sub Option1_Click(Index As Integer)
adresa = (((2 ^ Index) - 1) * 16) + 1 ' zatim trochu blbe......
Label4.Caption = adresa
End Sub

Private Sub prevod_Click()
order = 0
Timer1.Interval = 40
Timer1.Enabled = True   ' povol sber dat
End Sub

Private Sub Timer1_Timer()
Select Case order
    Case 0
        hodnota = janas(adresa)
        Label2.Caption = CStr(order)
    Case 1
        hodnota = janas(132)
        Label2.Caption = CStr(order)
    Case 2
        hodnota = janas(0)
        Label2.Caption = CStr(order)
        Label3(0).Caption = hodnota
        vysledek = hodnota
    Case 3
        hodnota = janas(2)
        Label2.Caption = CStr(order)
        Label3(1).Caption = hodnota
        vysledek = (vysledek * 256) + hodnota
        label1.Caption = vysledek
    Case 4
        hodnota = janas(1)
        Label2.Caption = CStr(order)
        Label3(2).Caption = hodnota
        vysledek = hodnota
    Case Else
        Label2.Caption = "konec prevodu"
        Timer1.Enabled = False
        vysledek = hodnota
        'label1.Caption = vysledek
End Select
    order = order + 1

End Sub
*}


function TJanasCardForm.janas(outdata: byte): byte;
var
  i: byte; // pom. promenna pro realizaci cyklu
  delitel: byte;
  ven: byte;
  BDSR: byte;
  precteno: byte;

  orlsd: boolean;
  timeout: longint;
  zero: byte;
begin
  timeout := mstime + 2;

  ven := outdata;
  delitel := 128;
  //Comm.Output := Chr(0);   // aktivuj CS vyslanim nuloveho bitu....
  zero := 0;
  Comm.Write(zero, 1);

  //While Comm.CDHolding = False do begin //ceka, az se bude realne vysilat, tj. CS aktivni
  //end;
  while true do begin
    if Comm.RLSD then begin
      Log('RlsHold ON');
      break;
    end;
    if (mstime >  timeout) then begin
      Log('RlsHold timedout');
      break;
    end;
  end;

  precteno := 0;  // nuluj  snimaci hodnota
  for i := 0 to 7 do begin // celkem 8 taktu hodin
    if (ven div delitel) = 1 then begin     // data IN bit pripravit na linku... >> RTS <<
        //Comm.RTSEnable := False;
        Comm.SetRTSState(false);
    end else begin
        //Comm.RTSEnable := True;
        Comm.SetRTSState(true);
    end;
    ven := ven mod delitel;
    delitel := delitel div 2;

    //Comm.DTREnable := False      // clk = >> DTR <<  na log. 0, pocatek synchronizacniho pulsu...
    Comm.SetDTRState(false);

    //if (Comm.DSRHolding = True) then
    if Comm.DSR then // precti data OUT
    begin
      BDSR := 0;
    end else begin
      BDSR := 1;
    end;
    precteno := (precteno * 2) + BDSR;
    //Comm.DTREnable := True;   //' clk = >> DTR <<  na log.1 , konec  synchronizacniho pulsu...
    Comm.SetDTRState(true);
  end;
  Result := precteno;  // hodnota pro navrat z funkce
end;


procedure TJanasCardForm.TimerTimer(Sender: TObject);
var value: TADValue;
begin
  if FModule <> nil then begin
    if FModule.ValueRead(value) then begin
       Log('Value=' + IntToStr(value));
    end;
    exit;
  end;


  if FInTimer then begin
    Log('Recursing to timer, exit.');
    exit;
  end;
  FInTimer := true;
  try
    Memo.Lines.BeginUpdate;
    try
      try
        case order of
          0: begin
            hodnota := janas(adresa);
            //Label2.Caption := IntToStr(order);
            Log('order=' + IntToStr(order) + ' hodnota(adr=' + IntToStr(adresa) + ')=' + IntToStr(hodnota));
          end;
          1: begin
            hodnota := janas(132);
            //Label2.Caption := IntToStr(order);
            Log('order=' + IntToStr(order) + ' hodnota(132)=' + IntToStr(hodnota));
          end;
          2: begin
            hodnota := janas(0);
            //Label2.Caption := IntToStr(order);
            Log('order=' + IntToStr(order) + ' hodnota(0)=' + IntToStr(hodnota));
            //Label3(0).Caption = hodnota
            //Label3.Caption := IntToStr(hodnota);
            vysledek := hodnota;
          end;
          3: begin
            hodnota := janas(2);
            vysledek := (vysledek * 256) + hodnota;
            //Label2.Caption := IntToStr(order);
            Log('order=' + IntToStr(order) + ' hodnota(2)=' + IntToStr(order) + ' vysledek=' + IntToStr(vysledek));
            //Label3(1).Caption = hodnota
            Label3.Caption := IntToStr(hodnota);
            label1.Caption := IntToStr(vysledek);

          end;
          4: begin
            hodnota := janas(1);
            //Label2.Caption := IntToStr(order);
            Log('order=' + IntToStr(order) + ' hodnota=' + IntToStr(hodnota));
            //Label3(2).Caption := hodnota;

            //Label3.Caption := IntToStr(hodnota);
            //vysledek := hodnota;
            //Log('vysledek=' + IntToStr(vysledek));

          end;
        else
            //Label2.Caption := 'konec prevodu';
            Log('konec prevodu');
            Timer.Enabled := False;
            //vysledek := hodnota;
            label1.Caption := IntToStr(vysledek);
            Log('VYSLEDEK: ' + IntToStr(vysledek));
        end;
        order := order + 1;
      except
        Timer.Enabled := false;
      end;
    finally
      Memo.Lines.EndUpdate;
    end;
  finally
    FInTimer := false;
  end;
  
end;

procedure TJanasCardForm.PrevodButtonClick(Sender: TObject);
begin
  try
    order := 0;
    Timer.Interval := 40;
    Timer.Enabled := True;   // povol sber dat
  except
    Timer.Enabled := false;
  end;
end;


procedure TJanasCardForm.OpenCloseButtonClick(Sender: TObject);
begin
  if not Comm.Enabled then begin
    Comm.DeviceName := ComNameEdit.Text;
    Comm.Open;
    Comm.Thread.DontSynchronize := true;
    Comm.SetDTRState(true);
    Comm.SetRTSState(false);
    Timer.Enabled := False;
    OpenCloseButton.Caption := 'Close port';
  end else begin
    Timer.Enabled := False;
    Comm.Close;
    OpenCloseButton.Caption := 'Open port';
  end;
end;

procedure TJanasCardForm.FormCreate(Sender: TObject);
begin
  adresa := 1;
  //OpenCloseButtonClick(Sender);
end;

procedure TJanasCardForm.Log(s:string);
begin
  Memo.Lines.Add(s);
end;

procedure TJanasCardForm.ClearLogButtonClick(Sender: TObject);
begin
  Memo.Lines.Clear;
end;

procedure TJanasCardForm.RadioGroupClick(Sender: TObject);
begin
  adresa := (((1 shl RadioGroup.ItemIndex) - 1) * 16) + 1; // zatim trochu blbe......
  Label4.Caption := IntToStr(adresa);
  if FModule <> nil then
    FModule.Channel := RadioGroup.ItemIndex;
end;

procedure TJanasCardForm.ModuleOpenStartClick(Sender: TObject);
begin
  Timer.Enabled := true;

  FModule := TJanasCardModule.Create(Self);
  FModule.Comm.DeviceName := ComNameEdit.Text;
  //FModule.OnLog := Log;
  //FModule.Open;
  FModule.Start;
end;

procedure TJanasCardForm.ModuleStopCloseClick(Sender: TObject);
begin
  Timer.Enabled := false;
  //FModule.Stop;
  //FModule.Close;
  //FModule.Free;
  //FModule := nil;
  FreeAndNil(FModule);
end;

end.
