unit TranslateDlg;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  Buttons, ExtCtrls, Grids, Matrices, MiscRoutines;

type
  TCNDirection=(dirNaturalToCode,dirCodeToNatural);
  TCountMethod=function(var Vec:TVector):double of object;

type
  TTranslateDialog = class(TForm)
    OKBtn: TButton;
    GCodePoint: TStringGrid;
    GNaturalPoint: TStringGrid;
    GBNaturalSpace: TGroupBox;
    GBCodeSpace: TGroupBox;
    RGOrder: TRadioGroup;
    RGProceed: TRadioGroup;
    ProcessButton: TButton;
    CBValueInPoint: TCheckBox;
    EValue: TEdit;
    Label1: TLabel;
    Bevel1: TBevel;
    procedure RGProceedClick(Sender: TObject);
    procedure RGOrderClick(Sender: TObject);
    procedure GNaturalPointEnter(Sender: TObject);
    procedure GCodePointEnter(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure GNaturalPointSetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
    procedure GCodePointSetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
    procedure ProcessButtonClick(Sender: TObject);
  public
    procedure AttachMLVector(_pML:PVector);
    procedure AttachDFVector(_pDF:PVector);
    procedure AttachCountMethod(Method:TCountMethod);
  private
    pML,pDF   : PVector;
    C,F       : TVector;
    CountFunc : TCountMethod;
    Direction : TCNDirection;
    // Изменение размеров сеток в соответствии с размерами векторов
    procedure AdjustGrids;
    // Обновление и пересчет полей
    procedure UpdateFields;
  end;

var
  TranslateDialog: TTranslateDialog;

implementation

{$R *.DFM}

procedure TTranslateDialog.AttachMLVector;
begin
  pML:=_pML;
  if((pML<>nil)and(pDF<>nil)) then
  begin
    AdjustGrids;
    Update;
  end;
end;

procedure TTranslateDialog.AttachDFVector;
begin
  pDF:=_pDF;
  if((pML<>nil)and(pDF<>nil)) then
  begin
    AdjustGrids;
    UpdateFields;
  end;
end;

procedure TTranslateDialog.AttachCountMethod;
begin
  CountFunc:=Method;
  EValue.Enabled:=(@CountFunc<>nil);
  CBValueInPoint.Checked:=(@CountFunc<>nil);
  CBValueInPoint.Enabled:=(@CountFunc<>nil);
end;

procedure TTranslateDialog.AdjustGrids;
var
  i : integer;
begin
  if((pML=nil)or(pDF=nil)) then
  begin
    Error('Внутренняя ошибка: TTranslateDialog.AdjustGrids: '+
      '(pML==NULL)||(pDF==NULL)');
    exit;
  end;
  if(C.nSize<>pML^.nSize) then C.Recreate(pML^.nSize);
  if(F.nSize<>pML^.nSize) then F.Recreate(pML^.nSize);
  C.Zero;
  F.Zero;
  if((GCodePoint.ColCount<>(pML^.nSize))or
     (GNaturalPoint.ColCount<>(pML^.nSize))) then
  begin
    GCodePoint.ColCount:=pML^.nSize;
    GNaturalPoint.ColCount:=pML^.nSize;
  end;
  for i:=0 to pML^.nSize-1 do
  begin
    GCodePoint.Cells[i,0]:=IntToStr(i+1);
    GCodePoint.Cells[i,1]:='0';
    GNaturalPoint.Cells[i,0]:=IntToStr(i+1);
    GNaturalPoint.Cells[i,1]:='0';
  end;
end;

function RetrieveDataFromGrid(const G:TStringGrid;var V:TVector):Boolean;
var
  i : integer;
begin
  Result:=False;
  if(G.ColCount<>V.nSize) then exit;
  try
    for i:=0 to V.nSize-1 do
      V.SetString(i,G.Cells[i,1]);
    Result:=True;
  except
    on EConvertError do exit;
  end;
end;

procedure TTranslateDialog.UpdateFields;
var
  i : integer;
begin
  if((pML=nil)or(pDF=nil)) then
  begin
    Error('Внутренняя ошибка: TTranslateDialog.Update: '+
      '(pML==NULL)||(pDF==NULL)');
    exit;
  end;
  case Direction of
    dirCodeToNatural:
    begin
      try
        for i:=0 to C.nSize-1 do
        begin
          C.SetString(i,GCodePoint.Cells[i,1])
        end;
      except
        on EConvertError do
        begin
          if(RGProceed.ItemIndex<>0) then
          begin
            Warning('В поле "Точка кодового пространства" должны'+#13+
              'находиться числовые значения');
            ActiveControl:=GCodePoint;
          end;
          EValue.Text:='';
          exit;
        end;
      end;
      for i:=0 to F.nSize-1 do
      begin
        F.Elements^[i]:=C.Elements^[i]*pDF^.Elements^[i]+
          pML^.Elements^[i];
        GNaturalPoint.Cells[i,1]:=FloatToStr(F.Elements^[i]);
      end;
    end;
    dirNaturalToCode:
    begin
      try
        for i:=0 to F.nSize-1 do
        begin
          F.SetString(i,GNaturalPoint.Cells[i,1])
        end;
      except
        on EConvertError do
        begin
          if(RGProceed.ItemIndex<>0) then
          begin
            Warning('В поле "Точка факторного пространства" должны'+#13+
              'находиться числовые значения');
            ActiveControl:=GNaturalPoint;
          end;
          EValue.Text:='';
          exit;
        end;
      end;
      for i:=0 to C.nSize-1 do
      begin
        C.Elements^[i]:=(F.Elements^[i]-pML^.Elements^[i])/
          pDF^.Elements^[i];
        GCodePoint.Cells[i,1]:=FloatToStr(C.Elements^[i]);
      end;
    end;
  end;
  if(@CountFunc<>nil) then
  begin
    EValue.Text:=FloatToStr(CountFunc(C));
  end;
end;

procedure TTranslateDialog.RGProceedClick(Sender: TObject);
begin
  if(RGProceed.ItemIndex<>0) then
    ProcessButton.Enabled:=True
  else
    ProcessButton.Enabled:=False;
end;

procedure TTranslateDialog.RGOrderClick(Sender: TObject);
begin
  case RGOrder.ItemIndex of
    0:
      begin
        // Автоопределение
        GNaturalPoint.Enabled:=True;
        GCodePoint.Enabled:=True;
        GNaturalPoint.Color:=clWindow;
        GCodePoint.Color:=clWindow;
      end;
    1:
      begin
        // От факторного к кодовому
        GNaturalPoint.Enabled:=True;
        GNaturalPoint.Color:=clWindow;
        GCodePoint.Enabled:=False;
        GCodePoint.Color:=clBtnFace;
      end;
    2:
      begin
        // Наоборот
        GCodePoint.Enabled:=True;
        GCodePoint.Color:=clWindow;
        GNaturalPoint.Enabled:=False;
        GNaturalPoint.Color:=clBtnFace;
      end;
  end;
end;

procedure TTranslateDialog.GNaturalPointEnter(Sender: TObject);
begin
  if(RGOrder.ItemIndex=0) then
    Direction:=dirNaturalToCode;
end;

procedure TTranslateDialog.GCodePointEnter(Sender: TObject);
begin
  if(RGOrder.ItemIndex=0) then
    Direction:=dirCodeToNatural;
end;

procedure TTranslateDialog.FormCreate(Sender: TObject);
begin
  C.Create(0);
  F.Create(0);
  pML:=nil;
  pDF:=nil;
  CountFunc:=nil;
end;

procedure TTranslateDialog.FormShow(Sender: TObject);
begin
  if((pML=nil)or(pDF=nil)) then
  begin
    Warning('TTranslateDialog.FormShow: (pML==NULL)||(pDF==NULL)');
    Close;
  end;
  UpdateFields;
end;

procedure TTranslateDialog.FormDestroy(Sender: TObject);
begin
  F.Destroy;
  C.Destroy;
end;

procedure TTranslateDialog.GNaturalPointSetEditText(Sender: TObject; ACol,
  ARow: Integer; const Value: String);
begin
  if(RGProceed.ItemIndex=0) then
    UpdateFields;
end;

procedure TTranslateDialog.GCodePointSetEditText(Sender: TObject; ACol,
  ARow: Integer; const Value: String);
begin
  if(RGProceed.ItemIndex=0) then
    UpdateFields;
end;

procedure TTranslateDialog.ProcessButtonClick(Sender: TObject);
begin
  UpdateFields;
end;

end.
