unit ltreu_marks;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,  ltrapi,  ltrapitypes, ltrapidefine, StdCtrls;

   //массив кодов режимов синхрометок. порядок должен совпадать с порядком
   //элементов в списке выбора в cbbSecondMarkMode и cbbStartMarkMode
const     mark_modes: array[0..4] of en_LTR_MarkMode = (LTR_MARK_INTERNAL,
                                                   LTR_MARK_EXT_DIGIN1_RISE,
                                                   LTR_MARK_EXT_DIGIN1_FALL,
                                                   LTR_MARK_EXT_DIGIN2_RISE,
                                                   LTR_MARK_EXT_DIGIN2_FALL);
type
  TMainForm = class(TForm)
    btnStartSecondMarsk: TButton;
    cbbSecondMarkMode: TComboBox;
    btnStopSecondMarks: TButton;
    lstCrates: TListBox;
    lbl1: TLabel;
    lbl2: TLabel;
    btnRefreshCratesList: TButton;
    lbl3: TLabel;
    cbbStartMarkMode: TComboBox;
    btnMakeStartMark: TButton;
    procedure btnStartSecondMarskClick(Sender: TObject);
    procedure btnStopSecondMarksClick(Sender: TObject);
    procedure btnRefreshCratesListClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnMakeStartMarkClick(Sender: TObject);
  private
    { Private declarations }
    crate_serials : array of string;

    function openCurrentCrate(var hcrate : TLTR) : Integer;
    procedure refreshCrateList();
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

function TMainForm.openCurrentCrate(var hcrate: TLTR) : Integer;
var
  err : Integer;
  idx : Integer;
  serial : string;
begin
  LTR_Init(hcrate);
  hcrate.cc := LTR_CC_CHNUM_CONTROL;
  // Если выбран крейт в списке, то используем его серийный номер для
  // запуска меток именно для него. Если крейт не выбран, то не заполняем
  // серийный номер и связь будет установлена с первым найденным крейтом
  idx:= lstCrates.ItemIndex;
  if (idx >= 0) and (idx < Length(crate_serials)) then
     serial:= crate_serials[idx]
  else
     serial:='';


  err := LTR_OpenCrate(hcrate, LTRD_ADDR_DEFAULT, LTRD_PORT_DEFAULT,
                       LTR_CRATE_IFACE_UNKNOWN, serial);
  if err <> LTR_OK then
     MessageDlg('Не удалось установить связь с крейтом: ' + LTR_GetErrorString(err), mtError, [mbOK], 0);
  openCurrentCrate:=err;
end;

// получение списка крейтов
procedure TMainForm.refreshCrateList();
var
  hsrv : TLTR;
  hcrate : TLTR;
  crate_info : TLTR_CRATE_INFO;
  err : Integer;
  crate_ind, crates_found, crates_cnt : LongWord;
  current_serial_list : array of string; //список номеров керйтов
  current_info_list : array of TLTR_CRATE_INFO;
  crate_type_name, crate_iface_name : string;
  idx : Integer;
  flags : LongWord;
begin
  //запоминаем выбранный элемент до зачистки, чтобы потом восстановить
  idx := lstCrates.ItemIndex;
  lstCrates.Items.Clear;
  SetLength(crate_serials, 0);

  flags := LTR_GETCRATES_FLAGS_WORKMODE_ONLY;

  // устанавливаем соединение с ltrd или LTR Server
  LTR_Init(hsrv);
  LTR_OpenSvcControl(hsrv, LTRD_ADDR_DEFAULT, LTRD_PORT_DEFAULT);
  err:=LTR_Open(hsrv);
  if err <> LTR_OK then
  begin
    MessageDlg('Не удалось установить связь с сервером: ' + LTR_GetErrorString(err), mtError, [mbOK], 0);
  end
  else
  begin
    //сперва получаем общее количество крейтов, вызывая LTR_GetCratesEx() с нулевым размером
    err:=LTR_GetCratesEx(hsrv, 0, flags, crates_found, crates_cnt, current_serial_list, current_info_list);
    if err = LTR_OK then
    begin
      if (crates_found > 0) then
      begin
        // устанавливаем размеры массивов в соответствии с найденным кол-вом
        // и вызываем функцию повторно, чтобы получить уже нужную информацию
        SetLength(current_serial_list, crates_found);
        SetLength(current_info_list, crates_found);
        err:=LTR_GetCratesEx(hsrv, crates_found, flags, crates_found, crates_cnt,
                             current_serial_list, current_info_list);
      end;
    end;

    if (err <> LTR_OK) then
      MessageDlg('Не удалось получить список крейтов: ' + LTR_GetErrorString(err), mtError, [mbOK], 0)
    else
    begin
      SetLength(crate_serials, crates_cnt);
      if crates_cnt > 0 then
      begin
        for crate_ind:=0 to crates_cnt-1 do
        begin


          // по коду типа устанавливаем соответствующее имя крейта для вывода
          case current_info_list[crate_ind].CrateType of
            LTR_CRATE_TYPE_LTR010:    crate_type_name := 'LTR-U-8/16';
            LTR_CRATE_TYPE_LTR021:    crate_type_name := 'LTR-U-1';
            LTR_CRATE_TYPE_LTR030:    crate_type_name := 'LTR-EU-8/16';
            LTR_CRATE_TYPE_LTR031:    crate_type_name := 'LTR-EU-2';
            LTR_CRATE_TYPE_LTR_CU_1:  crate_type_name := 'LTR-CU-1';
            LTR_CRATE_TYPE_LTR_CEU_1: crate_type_name := 'LTR-CEU-1';
          else
            crate_type_name := 'Неизвестный крейт';
          end;
          case current_info_list[crate_ind].CrateInterface of
            LTR_CRATE_IFACE_USB: crate_iface_name := 'USB';
            LTR_CRATE_IFACE_TCPIP: crate_iface_name := 'Ethernet';
          else
            crate_type_name := 'Неизвестный интерфейс';
          end;
          // добавляем в отображаемый список
          lstCrates.Items.Add(crate_type_name + ': ' + current_serial_list[crate_ind] + ' (' + crate_iface_name + ')');
          crate_serials[crate_ind] := current_serial_list[crate_ind];
        end;
      end;

      LTR_Close(hsrv);
    end;
  end;


  //восстанавливаем выбранный элемент по индексу
  if (idx >= 0)  and (lstCrates.Items.Count > 0) then
  begin
    //если элементов стало меньше, чем номер выбранного, то выбираем последний
    if idx <  lstCrates.Items.Count then
      lstCrates.ItemIndex := idx
    else
      lstCrates.ItemIndex := lstCrates.Items.Count - 1;
  end;
end;  

procedure TMainForm.btnStartSecondMarskClick(Sender: TObject);
var
  hcrate : TLTR;
  err : Integer;
begin
  err := openCurrentCrate(hcrate);
  if err = LTR_OK then
  begin
    err := LTR_StartSecondMark(hcrate, mark_modes[cbbSecondMarkMode.ItemIndex]);
    if err <> LTR_OK then
      MessageDlg('Не удалось запустить синхрометки: ' + LTR_GetErrorString(err), mtError, [mbOK], 0);
  end;

  LTR_Close(hcrate);
end;

procedure TMainForm.btnStopSecondMarksClick(Sender: TObject);
var
  hcrate : TLTR;
  err : Integer;
begin
  err := openCurrentCrate(hcrate);
  if err = LTR_OK then
  begin
    err := LTR_StopSecondMark(hcrate);
    if err <> LTR_OK then
      MessageDlg('Не удалось остановить синхрометки: ' + LTR_GetErrorString(err), mtError, [mbOK], 0);
  end;
  LTR_Close(hcrate);
end;

procedure TMainForm.btnRefreshCratesListClick(Sender: TObject);
begin
  refreshCrateList;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  refreshCrateList;
end;

procedure TMainForm.btnMakeStartMarkClick(Sender: TObject);
var
  hcrate : TLTR;
  err : Integer;
begin
  err := openCurrentCrate(hcrate);
  if err = LTR_OK then
  begin
    err := LTR_MakeStartMark(hcrate, mark_modes[cbbStartMarkMode.ItemIndex]);
    if err <> LTR_OK then
      MessageDlg('Не удалось сгенерировать метку СТАРТ: ' + LTR_GetErrorString(err), mtError, [mbOK], 0);
  end;
  LTR_Close(hcrate);
end;

end.
