unit u_form_db_lnk;

{$mode delphi}

interface

uses
  Classes,
  uDBConBase,
  urosx,

  Controls, StdCtrls, ExtCtrls, SysUtils,
  uConstantesSimSEE, dialogs,
  grids, xmatdefs, math, matreal;



type

  { TCFdblnk_BASE }
  TCFdblnk_BASE = class
    nombreCampo: string;
    s_ini: string;
    constructor CreateLoad(
      nombreCampo: string;
      dbrec: IDataset;
      defVal: string = '' );
    procedure Free; virtual;
    function check: boolean; virtual;
    procedure AppendForUpdate( var s: string ); virtual; abstract;
    function cf_caption: string; virtual; abstract;
  end;

  { TCFdblnk_Text }
  TCFdblnk_Text = class( TCFdblnk_Base )
    cf: TCustomEdit;
    minLength: integer;
    constructor CreateLoad(nombreCampo: string; campoFormulario: TCustomEdit;
      dbrec: IDataset;
      defVal: string = '';
      minLength: integer = 0);
    function check: boolean; override;
    procedure AppendForUpdate( var s: string ); override;
    function cf_caption: string; override;
  end;

  { TCFdblnk_Int }
  TCFdblnk_Int = class( TCFdblnk_Text )
    minVal, maxVal: integer;
    constructor CreateLoad(nombreCampo: string; campoFormulario: TCustomEdit;
      dbrec: IDataset;
      defVal: string = '';
      minVal: integer = -MaxInt; maxVal: integer = MaxInt );
    function check: boolean; override;
  end;

  { TCFdblnk_NReal }
  TCFdblnk_NReal = class( TCFdblnk_Text )
    minVal, maxVal: NReal;
    constructor CreateLoad(nombreCampo: string; campoFormulario: TCustomEdit;
      dbrec: IDataset;
      defVal: string = '';
      minVal: NReal = -MaxNReal;
      maxVal: NReal = MaxNReal );
    function check: boolean; override;
  end;


  { TCFdblnk_TablaXY }
  TCFdblnk_TablaXY = class( TCFdblnk_Base )
    x_minVal, x_maxVal: NReal;
    y_minVal, y_maxVal: NReal;
    s_ini_y: string;
    sg: TStringGrid;
    nombreCampo_y: string;

    constructor CreateLoad(nombreCampo_x, nombreCampo_y: string;
      campoFormulario: TStringGrid; dbrec: IDataset; defVal: string;
      x_minVal: NReal; x_maxVal: NReal; y_minVal: NReal; y_maxVal: NReal);
    procedure AppendForUpdate( var s: string ); override;
    function check: boolean; override;
  end;


  TCFcblnk_keyedSelect = class( TCFdblnk_Base )
    cf: TComboBox;
    lst_keys: TStringList;

    constructor CreateLoad( nombreCampoKey: string;
      campoFormulario: TComboBox; dbrec: IDataset; defVal: string;
      lst_keys, lst_nombres: TStringList ); overload;

    constructor CreateLoad(nombreCampoKey: string;
      campoFormulario: TComboBox;
      defVal: string; dbcon: TDBcon; tablaLookUp,
      CampoLookUp_key, CampoLookUp_Nombre, WhereLookup, OrderByLookup: string); overload;

    procedure AppendForUpdate( var s: string ); override;
    procedure Free; override;
  end;

  { Listado de Campos de Formulario }
  TCF_form_lst =class( TList )
    constructor Create;
    function GetUpdateStr: string; virtual;
    function check: boolean; virtual;
    procedure Free; virtual;
  end;

implementation


constructor TCFdblnk_BASE.CreateLoad(nombreCampo: string; dbrec: IDataset;
  defVal: string);
begin
  inherited Create;
  self.nombreCampo:= nombreCampo;
  if dbrec <> nil then
    s_ini:= dbrec.FieldByName( nombreCampo ).AsString
  else
    s_ini:= defVal;
end;


procedure TCFdblnk_BASE.Free;
begin
  inherited Free;
end;

function TCFdblnk_BASE.check: boolean;
begin
  result:= true;
end;

constructor TCFdblnk_Text.CreateLoad(nombreCampo: string;
  campoFormulario: TCustomEdit; dbrec: IDataset; defVal: string;
  minLength: integer);
begin
   inherited CreateLoad( nombreCampo, dbrec, defVal );
   self.minLength:= minLength;
   cf:= campoFormulario;
   cf.Text:= s_ini;
end;

function TCFdblnk_Text.check: boolean;
var
  s: string;
begin
  if self.minLength >0  then
  begin
    s:= cf.Text;
    if length( s ) < minLength then
    begin
      showmessage( cf_Caption+ '. Debe tener por lo menos: '+IntToStr( minLength )+' caracteres.' );
      cf.SetFocus;
      result:= false;
      exit;
    end;
  end;
  result:= true;
end;

procedure TCFdblnk_Text.AppendForUpdate( var s: string );
begin
  if cf.text <> s_ini then
  begin
    if s <> '' then s:= s+',';
    s:= s+' '+nombreCampo+'= '''+ cf.text+'''';
  end;
end;

function TCFdblnk_Text.cf_caption: string;
begin
  if cf is TLabeledEdit then
  begin
    result:=TLabeledEdit( cf ).EditLabel.Caption;
  end
  else
    result:= cf.Caption;
end;

constructor TCFdblnk_Int.CreateLoad(nombreCampo: string;
  campoFormulario: TCustomEdit; dbrec: IDataset; defVal: string;
  minVal: integer; maxVal: integer);
begin
  inherited CreateLoad( nombreCampo, campoFormulario, dbrec, defVal, 0 );
  self.minVal:= minval;
  self.maxval:= maxval;
end;

function TCFdblnk_Int.check: boolean;
var
  res: integer;
  rescod: integer;
begin
  val( cf.Text, res, rescod );
  if rescod <> 0 then
  begin
    showmessage( cf_Caption+ '. Se espera un número entero.' );
    cf.SetFocus;
    result:= false;
    exit;
  end;

  if (res < minVal) or ( res > maxval) then
  begin
    showmessage( cf_Caption+ '. El número debe estar entre: '+IntToStr( minval ) +' y '+IntToStr(maxval ) );
    cf.SetFocus;
    result:= false;
    exit;
  end;
  result:= true;
end;


constructor TCFdblnk_NReal.CreateLoad(nombreCampo: string;
  campoFormulario: TCustomEdit; dbrec: IDataset; defVal: string;
  minVal: NReal; maxVal: NReal);
begin
  inherited CreateLoad( nombreCampo, campoFormulario, dbrec, defVal, 0 );
  self.minVal:= minval;
  self.maxval:= maxval;
end;

function TCFdblnk_NReal.check: boolean;
var
  res: NReal;
  rescod: integer;
begin
  val( cf.Text, res, rescod );
  if rescod <> 0 then
  begin
    showmessage( cf_Caption+ '. Se espera un número real.' );
    cf.SetFocus;
    result:= false;
    exit;
  end;

  if (res < minVal) or ( res > maxval) then
  begin
    showmessage( cf_Caption+ '. El número debe estar entre: '+ FloatToStr( minval ) +' y '+ FloatToStr(maxval ) );
    cf.SetFocus;
    result:= false;
    exit;
  end;

  result:= true;
end;



constructor TCFdblnk_TablaXY.CreateLoad(nombreCampo_x, nombreCampo_y: string;
  campoFormulario: TStringGrid; dbrec: IDataset; defVal: string;
  x_minVal: NReal; x_maxVal: NReal; y_minVal: NReal; y_maxVal: NReal);
var
  vx, vy: TVectR;
  n: integer;
  k: integer;

begin
  inherited CreateLoad( nombreCampo_x, dbrec, defVal );
  self.nombreCampo_y:= nombreCampo_y;
  sg:= campoFormulario;
  self.x_minVal:= x_minval;
  self.x_maxval:= x_maxval;
  self.y_minVal:= y_minval;
  self.y_maxval:= y_maxval;
  s_ini_y:= dbrec.FieldByName( nombreCampo_y).AsString;
  vx := TVectR.Create_unserialize( s_ini );
  vy := TVectR.Create_unserialize( s_ini_y );

  n:= max( vx.n, vy.n );
  if n < (sg.RowCount - 1) then
    sg.RowCount:= n+1;

  for k:= 1 to vx.n do
    sg.Cells[1, k]:= FloatToStr( vx.e( k ) );
  for k:= 1 to vy.n do
    sg.Cells[2, k]:= FloatToStr( vy.e( k ) );

  vx.free;
  vy.free;
end;


function TCFdblnk_TablaXY.check: boolean;
var
  k, jCol, kRow: integer;
  res: NReal;
  rescod: integer;
  n: integer;
  s: string;
  minVal, maxVal: NReal;
begin
  n:= sg.RowCount -1;

  for jCol:= 1 to 2 do
  begin
    for kRow:= 1 to N do
    begin
      s:= sg.Cells[jCol, kRow];
      val( s, res, rescod );
      if rescod <> 0 then
      begin
        showmessage( cf_Caption+ '. Se espera un número real.' );
        sg.row:= kRow;
        sg.Col:= jCol;
        sg.SetFocus;
        result:= false;
        exit;
      end;

      if jCol = 1 then
      begin
        minVal:= x_minVal;
        maxVal:= x_maxVal;
      end
      else
      begin
        minVal:= y_minVal;
        maxVal:= y_maxVal;
      end;

      if (res < minVal) or ( res > maxval) then
      begin
        showmessage( cf_Caption+ '. El número debe estar entre: '+ FloatToStr( minval ) +' y '+ FloatToStr(maxval ) );
        sg.row:= kRow;
        sg.Col:= jCol;
        sg.SetFocus;
        result:= false;
        exit;
      end;
    end;
  end;

  result:= true;
end;


procedure TCFdblnk_TablaXY.AppendForUpdate( var s: string );
var
  vx, vy: TVectR;
  n: integer;
  jCol, kRow: integer;
  ss: string;

begin
  n:= sg.RowCount-1;
  vx:= TVectR.Create_Init( N );
  vy:= TVectR.Create_Init( N );
  for kRow:= 1 to N do
  begin
    ss:= sg.Cells[ 1, kRow ];
    vx.pon_e( kRow, StrToFloat( s ) );
    ss:= sg.Cells[ 2, kRow ];
    vy.pon_e( kRow, StrToFloat( s ) );
  end;

  ss:= vx.serialize;
  if ss <> s_ini then
  begin
    if s <> '' then s:= s+',';
    s:= s+' '+nombreCampo+'= '''+ ss +'''';
  end;

  ss:= vy.serialize;
  if ss <> s_ini_y then
  begin
    if s <> '' then s:= s+',';
    s:= s+' '+nombreCampo_y+'= '''+ ss +'''';
  end;

end;

constructor TCFcblnk_keyedSelect.CreateLoad( nombreCampoKey: string;
     campoFormulario: TComboBox; dbrec: IDataset; defVal: string;
     lst_keys, lst_nombres: TStringList );
begin
  inherited CreateLoad( nombreCampoKey, dbrec, defVal );
  cf:= campoFormulario;
  cf.Items:= lst_nombres;
  lst_keys:= lst_keys;
  cf.ItemIndex:= StrToInt( defVal );
end;

constructor TCFcblnk_keyedSelect.CreateLoad( nombreCampoKey: string;
  campoFormulario: TComboBox;
  defVal: string;
  dbcon: TDBcon;
  tablaLookUp, CampoLookUp_key, CampoLookUp_Nombre,
  WhereLookup, OrderByLookup: string );
var
  ds: IDataset;
  sql: string;
  lst_Keys, lst_Nombres: TStringList;

begin
  sql:= 'SELECT '+campoLookUp_key+', '+campoLookUp_Nombre
       +' FROM '+tablaLookup;
  if ( WhereLookup <> '' ) then
    sql:= sql + WhereLookup;
  if ( OrderByLookup <> '' ) then
    sql:= sql +' ORDER BY '+ OrderByLookup;
  ds:= dbcon.Query( sql );
  lst_Keys:= TStringList.Create;
  lst_Nombres:= TStringList.Create;
  while not ds.eof do
  begin
    lst_keys.Add( ds.GetFieldVal(0));
    lst_Nombres.add( ds.GetFieldVal( 1 ) );
  end;
  CreateLoad( nombreCampoKey, campoFormulario, ds, defVal, lst_keys, lst_nombres );
end;

procedure TCFcblnk_keyedSelect.AppendForUpdate( var s: string );
begin
  if cf.ItemIndex <> StrToInt( s_ini ) then
  begin
    if s <> '' then s:= s+',';
    s:= s+' '+nombreCampo+'= ' + lst_keys[ cf.ItemIndex ];
  end;
end;

procedure TCFcblnk_keyedSelect.Free;
begin
  inherited Free;
  lst_Keys.Free;
end;



constructor TCF_form_lst.Create;
begin
  inherited Create;
end;

function TCF_form_lst.GetUpdateStr: string;
var
  k: integer;
  s: string;
begin
  s:= '';
  for k:= 0 to count - 1 do
     TCFdblnk_BASE( items[k] ).AppendForUpdate( s );
  result:= s;
end;

function TCF_form_lst.check: boolean;
var
  k: integer;
  res: boolean;
begin
  res:= true;
  for k:= 0 to count - 1 do
  begin
    if not TCFdblnk_BASE( items[ k ] ).check then
     begin
       res:= false;
       break;
     end;
  end;
  result:= res;
end;

procedure TCF_form_lst.Free;
var
  k: integer;
begin
  for k:= 0 to count - 1 do
    TCFdblnk_BASE( items[ k ] ).Free;
  inherited Free;
end;


end.

