unit ChannelInput;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, BaseGrid, StdCtrls, ExtCtrls;

type
  TChannelInputForm = class(TForm)
    cmbShortModule: TComboBox;
    edFullTagname: TEdit;
    cmbShortTagname: TComboBox;
    Label1: TLabel;
    btOk: TButton;
    btCancel: TButton;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    lbNotfound: TLabel;
    Label5: TLabel;
    edDescr: TEdit;
    btEmpty: TButton;
    procedure FormActivate(Sender: TObject);
    procedure cmbShortModuleChange(Sender: TObject);
    procedure cmbShortTagnameChange(Sender: TObject);
    procedure edFullTagnameChange(Sender: TObject);
    procedure btOkClick(Sender: TObject);
    procedure btEmptyClick(Sender: TObject);
  private
    canChange: boolean;

    procedure updateFullTagname;
    procedure updateNotFoundLabelVisibility;
    function sortWithNumPadding(listText: string): string;
  public
    tagindex: Integer;
    tagname: string;
    descr: string;
  end;


  procedure showChannelInput(tagname: string; descr: string);

var
  ChannelInputForm: TChannelInputForm = nil;

implementation
uses
  infodlg,
  Users,
  ChannelMap,
  MesConst,
  MesLogging,
  HyperStr,
  SetChannel,
  DataClientBase,
  main,
  numbers,
  TagStorage,
  RpVisualGlobal;

{$R *.dfm}

procedure showChannelInput(tagname: string; descr: string);
var
  ti, tt: integer;
begin
  ti := GetTagIndex(tagname);
  if ti < 0 then begin
    showInfoDlg('Тег не найден ' + tagname, mtError, [mbOK], 0);
    exit;
  end;

  tt := getTagType(ti);
  if tt = TAGTYPE_INT then begin
    SetChannelExecute(ti, descr);
  end
  else if tt = TAGTYPE_STRING then begin
    if ChannelInputForm = nil then
      ChannelInputForm := TChannelInputForm.Create(Form1);
    ChannelInputForm.tagindex := ti;
    ChannelInputForm.tagname := tagname;
    ChannelInputForm.descr := descr;
    ChannelInputForm.ShowModal;
  end;
end;


procedure TChannelInputForm.FormActivate(Sender: TObject);
begin
  edDescr.Text := descr;
  chmapUpdate;
  cmbShortModule.Items.Text := sortWithNumPadding( chmapGetModules() );

  canChange := True;
  edFullTagname.Text := GetTagValueString( tagindex );

  cmbShortModule.SetFocus;
  cmbShortModule.SelectAll;
end;


procedure TChannelInputForm.cmbShortModuleChange(Sender: TObject);
begin
  if not canChange then exit;
  canChange := false;
  cmbShortTagname.Items.Text := sortWithNumPadding( chmapGetTagnamesByModule( cmbShortModule.Text ));
  updateFullTagname();
  canChange := true;
end;


procedure TChannelInputForm.cmbShortTagnameChange(Sender: TObject);
begin
  if not canChange then exit;
  canChange := false;
  updateFullTagname();
  canChange := true;
end;


procedure TChannelInputForm.updateFullTagname;
begin
  edFullTagname.Text := chmapGetFullTagname(cmbShortModule.Text, cmbShortTagname.Text);
  updateNotFoundLabelVisibility;
end;


procedure TChannelInputForm.edFullTagnameChange(Sender: TObject);
var
  p: PChannelRec;
begin
  if not canChange then exit;
  canChange := false;

  p := chmapFindByFullTagname(edFullTagname.Text);
  if p <> nil then begin
    cmbShortTagname.Items.Text := sortWithNumPadding( P.taglist.Text );
    cmbShortModule.Text := p.shortModule;
    cmbShortTagname.Text := p.shortTagname;
  end else begin
    cmbShortModule.Text := '';
    cmbShortTagname.Text := '';
  end;

  updateNotFoundLabelVisibility;
  canChange := true;
end;


procedure TChannelInputForm.updateNotFoundLabelVisibility;
begin
  lbNotFound.visible := (edFullTagname.Text<>'')  and  (GetTagIndex( edFullTagname.Text ) < 0);
end;


procedure TChannelInputForm.btOkClick(Sender: TObject);
var
  sl: TStringList;
  foundName: string;
  foundIndex: Integer;
  i, res: integer;
begin
  if not CheckAccess(PREVILEG_CHANNELS, true) then
    exit;


  if Trim(edFullTagname.Text) <> '' then begin
    sl := TStringList.Create;
    try
      FindTags('*_Channel;*_Channel?;*_Chnl?In;*_Chnl?Out', sl);
      for i:=0 to sl.Count-1 do begin
        foundName := sl[i];
        foundIndex := Integer(sl.Objects[i]);

        if (foundIndex <> tagindex) and
              (getTagType(foundIndex) = TAGTYPE_STRING) and
              (GetTagValueString(foundIndex) = edFullTagname.Text) then
        begin
          res := showInfoDlg('Выбранный адрес уже используется в другом канале:'#13#13 + foundName +
                #13#13'Установить введенный адрес и очистить другой канал?', 'Подтверждение', 'Без очистки', 'С очисткой', 'Отмена', clYellow);

          if res = 3 then
            Exit;

          if res = 2 then begin
            SetTagValueString(foundIndex, '');
            SaveMessageText(
              mcSetChannel_text,
              foundName,
              'пустой адрес',
              mcSetChannel_bc,
              mcSetChannel_fc );
          end;
        end;
      end;
    finally
      sl.Free;
    end;
  end;


  SetTagValueString(tagindex, edFullTagname.Text);
  SaveMessageText(
        mcSetChannel_text,
        descr,
        chmapGetPrettyChannelStr(edFullTagname.Text),
        mcSetChannel_bc,
        mcSetChannel_fc );


  ModalResult := mrOk;
end;


function TChannelInputForm.sortWithNumPadding(listText: string): string;

  function conv(s: string): string;
  var
    i,j,k,v: integer;
    c: Char;
  begin
    Result := '';
    k := 1;
    s := s + ' ';
    for i:=1 to Length(s) do begin
      c := s[i];
      if not( c in ['0'..'9'] ) then begin
        if k < i then begin
          Val(Copy(s, k, i - k), v, j);
          v := v + 1000000;
          Result := Result + IntToStr(v);
        end;
        Result := Result + c;
        k := i + 1;
      end;
    end;
  end;

  function funcSort(list: TStringList; i1, i2: Integer): Integer;
  begin
    Result := CompareStr(conv(list[i1]), conv(list[i2]));
  end;

var
  sl: TStringList;
begin
  sl := TStringList.Create;
  sl.Text := listText;

  sl.CustomSort(@funcSort);
  Result := sl.Text;

  sl.Free;
end;


procedure TChannelInputForm.btEmptyClick(Sender: TObject);
begin
  edFullTagname.Text := '';
  btOkClick(nil);
end;

end.
