unit RcpMan;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, Buttons, ExtCtrls;

const
  RCPMAN_CURRENT_STR = 0;
  RCPMAN_CURRENT_VALUE = 1;
  RCPMAN_CONTROL_TYPE = 2;
  RCPMAN_TAGNAME = 3;
  RCPMAN_TAGNAME_INDEX = 4;
  RCPMAN_LIST_START = 5;


type
  TRcpManForm = class(TForm)
    list: TListView;
    Panel1: TPanel;
    btDel: TBitBtn;
    pnl2: TPanel;
    Label1: TLabel;
    edName: TEdit;
    pc: TPageControl;
    tsDescr: TTabSheet;
    btApply: TBitBtn;
    btCancel: TBitBtn;
    btAdd: TBitBtn;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    memo: TMemo;
    Bevel1: TBevel;
    btRead: TBitBtn;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure listChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure btCancelClick(Sender: TObject);
    procedure listChanging(Sender: TObject; Item: TListItem;
      Change: TItemChange; var AllowChange: Boolean);
    procedure edNameChange(Sender: TObject);
    procedure memoChange(Sender: TObject);
    procedure SetHasChanges(Sender: TObject);
    procedure btAddClick(Sender: TObject);
    procedure btDelClick(Sender: TObject);
    procedure btApplyClick(Sender: TObject);
    procedure btReadClick(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
  private
    { Private declarations }
    CfgPath: string;
    CfgFileName: string;
    Descr: string;

    HasChanges: boolean;
    IsLoading: boolean;
  public
    CfgName: string;
    PromtStr: string;

    procedure SetPromts;
    procedure LoadRcpStruc;
    procedure LoadReceipts;
  end;

  procedure RcpManShow(ARcpCfgName: string; APromtStr: string='Рецепты;Название рецепта;Новый рецепт');


var
  RcpManForm: TRcpManForm;

implementation
uses
  rpsysutils,
  status,
  tagstorage,
  hyperstr,
  RcpManFrame,
  main;

{$R *.dfm}

procedure RcpManShow(ARcpCfgName: string; APromtStr: string);
begin

  if RcpManForm = nil then
    RcpManForm := TRcpManForm.Create(Form1)
  else
    RcpManForm.WindowState := wsNormal; 

  RcpManForm.CfgName := ARcpCfgName;
  RcpManForm.PromtStr := APromtStr;
  RcpManForm.SetPromts;

  RcpManForm.LoadRcpStruc;
  RcpManForm.LoadReceipts;

  if RcpManForm.list.Items.Count>0 then
    RcpManForm.list.items[0].Selected := true; 

  RcpManForm.Show;

end;



procedure TRcpManForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
  flag: boolean;
begin
  listChanging(nil, list.Selected, ctState, flag);

  RcpManForm := nil;
  Release;
end;

procedure TRcpManForm.LoadRcpStruc;
var
  F: TextFile;
  s,ss: string;
  i,j,n,k: integer;
  tab: TTabSheet;
  li: TListItem;
  frm : TRcpManFrameForm;
begin
  IsLoading := true;
  n := pc.PageCount-2;
  for i:=0 to n do
    pc.Pages[0].Free;

  CfgPath := CurDir + 'Receipt\';
  CfgFileName := CfgPath + CfgName + '.rcp_struc';
  AssignFile(F, CfgFileName);
  try
    reset(F);

    tab := nil;
    frm := nil;
    li := nil;

    while not eof(F) do begin
      readln(F, s);
      s := trim(s);
      if s='' then continue;

      // описание
      ss := 'DESCR';
      if uppercase(copy(s,1,length(ss)))=ss then begin
        Descr := trim( copy(s, length(ss)+2, length(s)-length(ss)-1) );
        Caption := Descr;
        Continue;
      end;

      // страница
      ss := 'PAGE';
      if uppercase(copy(s,1,length(ss)))=ss then begin
        tab := TTabSheet.Create(pc);
        tab.PageControl := pc;
        tab.Caption := copy(s, length(ss)+2, length(s)-length(ss)-1);
        tab.PageIndex := pc.PageCount-2;

        frm := TRcpManFrameForm.Create(tab);
        frm.Parent := tab;
        frm.Align := alClient;
        frm.BorderStyle := bsNone;
        frm.OnClick := SetHasChanges;
        frm.Show;

        li := nil;
        Continue;
      end;

      // группа
      ss := 'GROUP';
      if uppercase(copy(s,1,length(ss)))=ss then begin
        if frm=nil then continue;
        with frm.list.Items.Add do
          caption := trim(copy(s, length(ss)+2, length(s)-length(ss)-1));

        li := nil;
        Continue;
      end;

      // параметр
      ss := 'LIST';
      if uppercase(copy(s,1,length(ss)))=ss then begin
        if frm=nil then continue;
        delete(s,1,length(ss)+1);
        k := pos(';', s);

        li := frm.list.Items.Add;
        with li do begin
          caption := '      ' + copy(s, 1, k-1);
          for j:=0 to RCPMAN_LIST_START-1 do
            SubItems.Add('');

          SubItems[RCPMAN_TAGNAME] := trim(copy(s,k+1,length(s)-k));
          SubItems[RCPMAN_TAGNAME_INDEX] := inttostr( GetTagIndex(SubItems[RCPMAN_TAGNAME]) );
          SubItems[RCPMAN_CURRENT_VALUE] := '0';
          SubItems[RCPMAN_CONTROL_TYPE] := 'LIST';
        end;
                                                              
        Continue;
      end;

      // параметр
      ss := '.';
      if uppercase(copy(s,1,length(ss)))=ss then begin
        if li=nil then continue;
        li.SubItems.Add( trim(copy(s, 2, length(s)-1)) );
      end;

    end;

  finally
    try
      CloseFile(F);
    except
    end;
  end;

  pc.ActivePageIndex := 0;
  IsLoading := false;
end;

// Загрузка маршрутов
procedure TRcpManForm.LoadReceipts;
var
  sr: TSearchRec;
  F: TextFile;
  s,findname: string;
  i: integer;
begin
  IsLoading := true;
  list.Items.Clear;
  findname := ChangeFileExt(CfgFileName, '.rcp_*');
//  s := CfgPath + 'S02.rcp_*';
//  if s<>findname then showmessage(s +' '+findname);
  try
    if FindFirst(findname, faAnyFile, sr) = 0 then
      repeat
        try
          AssignFile(F, CfgPath + sr.Name);
          Reset(F);
          Readln(F, s);
          if pos('.rcp_struc', sr.Name)=0 then
            with list.Items.add do begin
              caption := s;
              subitems.add(sr.Name);
            end;
        finally
          try CloseFile(F) except end;
        end;
      until FindNext(sr)<>0;
  finally
    try FindClose(sr) except end;
  end;

  IsLoading := false;
end;

// Загрузка маршрута
procedure TRcpManForm.listChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
var
  F: TextFile;
  s, fname: string;
  i,j,k,n,v: integer;
  is_descr: boolean;
  tagname: string;
begin
  if Change <> ctState then exit;

  // очистка
  if list.Selected=nil then begin
    pnl2.Visible := false;
    exit;
  end;


  for i:=0 to pc.PageCount-2 do begin
    with TRcpManFrameForm(pc.Pages[i].Controls[0]).list do begin
      n := Items.Count-1;
      for j:=0 to n do
        if items[j].SubItems.Count>0 then begin
          items[j].SubItems[RCPMAN_CURRENT_VALUE] := '0';
          items[j].SubItems[RCPMAN_CURRENT_STR] := items[j].SubItems[RCPMAN_LIST_START];
        end;
    end;
  end;


  fname := CfgPath + list.Selected.SubItems[0];
  if fileexists(fname) then begin

    IsLoading := true;
    pnl2.Visible := true;
    try
      memo.Lines.Clear;
      AssignFile(F, fname);
      Reset(F);
      Readln(F, s);
      edName.Text := s;

      is_descr := false;
      while not eof(F) do begin
        Readln(F, s);

        if trim(uppercase(s))='@DESCRIPTION' then begin
          is_descr := true;
          continue;
        end;

        if is_descr then begin
          memo.Lines.Add(s);
        end else begin
          s := trim(s);
          if s='' then continue;

          k:=pos('=', s);
          tagname := trim(copy(s,1,k-1));
          delete(s,1,k);
          val(s,v,i);


          for i:=0 to pc.PageCount-2 do begin
            with TRcpManFrameForm(pc.Pages[i].Controls[0]).list do begin
              n := Items.Count-1;
              for j:=0 to n do
                if items[j].SubItems.Count>0 then begin
                  if items[j].SubItems[RCPMAN_TAGNAME] = tagname then begin
                    if v < (items[j].SubItems.Count - RCPMAN_LIST_START) then begin
                      items[j].SubItems[RCPMAN_CURRENT_STR] := items[j].SubItems[RCPMAN_LIST_START + v];
                      items[j].SubItems[RCPMAN_CURRENT_VALUE] :=inttostr(v);
                    end;
                  end;
                end;
            end;
          end;
        end;

      end;

    finally
      try CloseFile(F) except end;
    end;

  end;  

  IsLoading := false;

end;

procedure TRcpManForm.SetPromts;
var
  i: integer;
begin
  i:=1;
  PromtStr := PromtStr + ';';
  list.Columns[0].Caption := Parse(PromtStr, ';', i);
  label1.Caption := Parse(PromtStr, ';', i);
  edName.Hint := Parse(PromtStr, ';', i);
end;

procedure TRcpManForm.btCancelClick(Sender: TObject);
begin
  close;
end;

// Сохранение изменений
procedure TRcpManForm.listChanging(Sender: TObject; Item: TListItem;
  Change: TItemChange; var AllowChange: Boolean);
var
  F: TextFile;
  s: string;
  i,j,n: integer;
begin
  if Change <> ctState then exit;
  if HasChanges then
    if list.Selected <> nil then begin
      AssignFile(F, CfgPath + list.Selected.SubItems[0]);
      try
        rewrite(F);

        writeln(F, edName.text);
        writeln(F, '');

        for i:=0 to pc.PageCount-2 do begin
          with TRcpManFrameForm(pc.Pages[i].Controls[0]).list do begin
            n := Items.Count-1;
            for j:=0 to n do
              if items[j].SubItems.Count>0 then begin
                s := items[j].SubItems[RCPMAN_TAGNAME] + '=' + items[j].SubItems[RCPMAN_CURRENT_VALUE];
                writeln(F, s);
              end;
          end;
        end;

        writeln(F, '');
        writeln(F, '@DESCRIPTION');
        writeln(F, memo.lines.text);


      finally
        try CloseFile(F) except end;
      end;
    end;
  HasChanges := false;
end;

procedure TRcpManForm.edNameChange(Sender: TObject);
begin
  if IsLoading then exit;
  if list.Selected=nil then exit;
  list.Selected.Caption := edName.Text;
  HasChanges := true;
end;

procedure TRcpManForm.memoChange(Sender: TObject);
begin
  if IsLoading then exit;
  HasChanges := true;
end;

procedure TRcpManForm.SetHasChanges(Sender: TObject);
begin
  HasChanges := true;
end;


// Добавление рецепта
procedure TRcpManForm.btAddClick(Sender: TObject);
var
  F: TextFile;
  li: TListItem;
  s: string;
  i,j,k,n,v: integer;
  flag: boolean;
begin
  n:=0;
  for i:=0 to list.Items.Count-1 do begin
    s := list.Items[i].SubItems[0];
    k := pos('.rcp_', s)+5;
    val(copy(s, k, length(s)-k+1), v, j);
    if v>=n then n:=v+1;
  end;
  li := list.Items.Add;
  li.Caption := edName.Hint;
  li.SubItems.Add( ChangeFileExt( ExtractFileName(CfgFileName), '.rcp_') + inttostr(n) );

  AssignFile(F, CfgPath + li.SubItems[0]);
  try
    rewrite(F);
    writeln(F, edName.Hint);
  finally
    try CloseFile(F) except end;
  end;


  listChanging(nil, list.Selected, ctState, flag);

  list.Selected := li;
  li.Selected := true;

end;

// Удаление рецепта
procedure TRcpManForm.btDelClick(Sender: TObject);
var
  fname: string;
  i: integer;
begin
  if list.Selected=nil then exit;
  if MessageDlg('Удалить "'+ list.Selected.Caption + '"?', mtConfirmation, mbOKCancel, 0) <> mrOk then exit;

  fname := CfgPath + list.Selected.SubItems[0];
  if fileexists(fname) then begin
    DeleteFile(fname);
  end;
  i := list.Selected.Index;
  if i = list.Items.Count-1 then dec(i);
  list.Selected.Delete;
  if i>=0 then begin
    list.Selected := list.items[i];
    list.items[i].Selected := true;
    list.items[i].focused := true;
  end;
end;

procedure TRcpManForm.btApplyClick(Sender: TObject);
type
  PrcpmanTagRec =^TrcpmanTagRec;
  TrcpmanTagRec = record
    TagIndex: integer;
    WriteValue: integer;
  end;
var
  i,j,k,n: integer;
  a: array of PrcpmanTagRec;
  flag: boolean;
begin
  if list.Selected=nil then exit;
  if MessageDlg('Установить "'+ list.Selected.Caption + '"?', mtConfirmation, mbOKCancel, 0) <> mrOk then exit;

  k := 0;

  for i:=0 to pc.PageCount-2 do begin
    with TRcpManFrameForm(pc.Pages[i].Controls[0]).list do begin
      n := Items.Count-1;
      for j:=0 to n do
        if items[j].SubItems.Count>0 then begin
          SetLength(a, k+1);
          new(a[k]);
          a[k].TagIndex := strtoint( items[j].SubItems[RCPMAN_TAGNAME_INDEX] );
          a[k].WriteValue := strtoint( items[j].SubItems[RCPMAN_CURRENT_VALUE] );
          inc(k);
        end;
    end;
  end;


  ShowStatusMessageA('Установка данных','подождите...', clLime);
  n := length(a)-1;
  for j:=1 to 5 do begin
    flag := true;
    for i:=0 to n do begin
      if a[i].TagIndex <> -1 then
        if a[i].WriteValue <> GetTagValue(a[i].TagIndex) then begin
          SetTagValue(a[i].TagIndex, a[i].WriteValue);
          flag := false;
        end;
    end;

    if flag then break;
//    rpDelay(1000);
    DelayMs(1000, true);
  end;
  CloseStatusMessage;


  n := length(a)-1;
  for i:=0 to n do
    Dispose(a[i]);
  a := nil;

  if not flag then
    MessageDlg('Установка не выполнена!', mtError, [mbOK], 0);

  close;
end;

procedure TRcpManForm.btReadClick(Sender: TObject);
var
  i,j,k,n,v: integer;
  flag: boolean;
begin
  if list.Selected=nil then exit;
  if MessageDlg('Принять текущие значения в "'+ list.Selected.Caption + '"?', mtConfirmation, mbOKCancel, 0) <> mrOk then exit;

  for i:=0 to pc.PageCount-2 do begin
    with TRcpManFrameForm(pc.Pages[i].Controls[0]).list do begin
      n := Items.Count-1;
      for j:=0 to n do
        if items[j].SubItems.Count>0 then begin
          v := GetTagValue( strtoint( items[j].SubItems[RCPMAN_TAGNAME_INDEX] ) );
          if v < (items[j].SubItems.Count - RCPMAN_LIST_START) then begin
            items[j].SubItems[RCPMAN_CURRENT_STR] := items[j].SubItems[RCPMAN_LIST_START + v];
            items[j].SubItems[RCPMAN_CURRENT_VALUE] :=inttostr(v);
          end;
        end;
    end;
  end;
  HasChanges := true;

end;

procedure TRcpManForm.FormDeactivate(Sender: TObject);
begin
  WindowState := wsMinimized;
end;

end.
