Ver Mensaje Individual
  #7  
Antiguo 19-03-2014
gorsan gorsan is offline
Miembro
 
Registrado: jun 2003
Ubicación: Alcala de Henares (Madrid)
Posts: 87
Reputación: 21
gorsan Va por buen camino
Hola ecfisa. Muchas gracias por tu ayuda y por "pegarte" con mi farragoso código. Ahí va más porque sí, hay más código implicado.
Si tienes paciencia échale un vistazo a ver si ves algo que te llame la atención en el sentido que nos ocupa. Se trata del módulo de datos donde están alojados los componentes que manejan los datos. Si, ya se, es un pantano. Pero yo no veo aquí tampoco el núcleo del error que nos ocupa. En tres veces por los problemas de numero máximo de caracteres admitidos:

Código Delphi [-]
unit Mod_Dat2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, StdCtrls, Mask, DBCtrls, ExtCtrls, ToolWin,
  ExtDlgs, jpeg, DB, Buttons, IBCustomDataSet, IBSQL, IBDatabase,
  IBStoredProc, RpDefine, RpCon, RpConDS, RpRave, RpBase, RpSystem, IBQuery,
  RpConBDE;

type
  TDMFicha = class(TDataModule)
    IBFicha: TIBDataSet;
    DSFicha: TDataSource;
    IBTLocal_Ficha: TIBTransaction;
    IBStoredProc1: TIBStoredProc;
    IBFichaCONTADOR: TIntegerField;
    IBFichaPRIMER_APELLIDO: TIBStringField;
    IBFichaSEGUNDO_APELLIDO: TIBStringField;
    IBFichaNOMBRE: TIBStringField;
    IBFichaMODULO: TIntegerField;
    IBFichaTALLER: TIBStringField;
    IBFichaTURNO: TIBStringField;
    IBFichaALTA: TDateField;
    IBFichaBAJA: TDateField;
    IBFichaFOTO: TBlobField;
    IBFichaOBSERVACIONES: TMemoField;
    IBFichaFORMATO: TIBStringField;
    IBFichaDIA_1: TIBStringField;
    IBFichaDIA_2: TIBStringField;
    IBFichaDIA_3: TIBStringField;
    IBFichaDIA_4: TIBStringField;
    IBFichaDIA_5: TIBStringField;
    IBFichaDIA_6: TIBStringField;
    IBFichaDIA_7: TIBStringField;
    IBFichaDIA_8: TIBStringField;
    IBFichaDIA_9: TIBStringField;
    IBFichaDIA_10: TIBStringField;
    IBFichaDIA_11: TIBStringField;
    IBFichaDIA_12: TIBStringField;
    IBFichaDIA_13: TIBStringField;
    IBFichaDIA_14: TIBStringField;
    IBFichaDIA_15: TIBStringField;
    IBFichaDIA_16: TIBStringField;
    IBFichaDIA_17: TIBStringField;
    IBFichaDIA_18: TIBStringField;
    IBFichaDIA_19: TIBStringField;
    IBFichaDIA_20: TIBStringField;
    IBFichaDIA_21: TIBStringField;
    IBFichaDIA_22: TIBStringField;
    IBFichaDIA_23: TIBStringField;
    IBFichaDIA_24: TIBStringField;
    IBFichaDIA_25: TIBStringField;
    IBFichaDIA_26: TIBStringField;
    IBFichaDIA_27: TIBStringField;
    IBFichaDIA_28: TIBStringField;
    IBFichaDIA_29: TIBStringField;
    IBFichaDIA_30: TIBStringField;
    IBFichaDIA_31: TIBStringField;
    IBFichaHORAS_REALES: TIntegerField;
    IBFichaHORAS_CALCULADAS: TIntegerField;
    IBFichaSALARIO: TFloatField;
    IBFichaANO: TSmallintField;
    IBFichaMES: TIBStringField;
    RvDataSetConnection1: TRvDataSetConnection;
    RvProject1: TRvProject;
    IBQGeneral_Taller_Turno: TIBQuery;
    IBQNomina_Taller_Turno: TIBQuery;
    RvDataSetConnection2: TRvDataSetConnection;
    RvProject2: TRvProject;
    IBQuery1: TIBQuery;
    IBQuery2: TIBQuery;
    IBQuery3: TIBQuery;
    IBQuery4: TIBQuery;
    procedure IBFichaAfterDelete(DataSet: TDataSet);
    procedure IBFichaAfterPost(DataSet: TDataSet);
    procedure DSFichaDataChange(Sender: TObject; Field: TField);
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
    procedure Buscar(Campo, Texto : string);
    procedure Ordena(Campo, Orientacion: String);
    procedure Calcular_HorasTrabajadas;
    procedure IBFichaBeforeInsert(DataSet: TDataSet);
    procedure Calculo_Horas_Minoradas;
    function ReduccionHoras(HR: integer; FC: double; PH: double):double;
    function CalculoSalario(HC: double; PH: double):double;
    procedure CreateTable(const TableName1: string);
    procedure CreateTableParametros(const TableName2: string);
    procedure CreateTableTotales(const TableName3: string);
  private
    { Private declarations }
    FOriginalSQL : string;
  public
    { Public declarations }
  end;

var
  DMFicha: TDMFicha;

implementation

uses Man_Ficha, Man_Nomina, Mod_Dat5, Mod_Dat1, Apertura, Apertura2;

{$R *.dfm}

procedure TDMFicha.IBFichaAfterDelete(DataSet: TDataSet);
begin
   IBFicha.Transaction.CommitRetaining;
   IBFicha.Refresh;
end;

procedure TDMFicha.IBFichaAfterPost(DataSet: TDataSet);
begin
   IBFicha.Transaction.CommitRetaining;
   IBFicha.Refresh;
end;

procedure TDMFicha.DSFichaDataChange(Sender: TObject; Field: TField);
var
  m: TStream;
begin
 if IBFichaFOTO.IsNull then
   //para registros sin imagen poner imagen vacia.
   WFicha.Image2.Picture:=nil
  else
   begin
    if IBFichaFORMATO.AsString='BMP' then
      //si es formato BMP
      WFicha.Image2.Picture.Graphic:=TBitmap.Create
    else if IBFichaFORMATO.AsString='JPG' then
      //si es formato JPG
      WFicha.Image2.Picture.Graphic:=TJpegImage.Create
    else
     Exit;
    //copiar los datos desde la tabla con un stream
    m:=IBFicha.CreateBlobStream(IBFichaFOTO, bmRead);
    WFicha.Image2.Picture.Graphic.LoadFromStream(m);
    m.Free;
   end;
   With WFicha.StatusBar1 do
   begin
     Panels[0].Text:=' Registros -> '+IntToStr(DMFicha.IBFicha.RecordCount);
     Panels[1].Text:=' '+DMFicha.IBFicha.FieldByName('PRIMER_APELLIDO').asString;
     Panels[2].Text:=' '+DMFicha.IBFicha.FieldByName('SEGUNDO_APELLIDO').asString;
     Panels[3].Text:=' '+DMFicha.IBFicha.FieldByName('NOMBRE').asString;
     Panels[4].Text:=' '+DMFicha.IBFicha.FieldByName('MODULO').asString;
     Panels[5].Text:=' '+DMFicha.IBFicha.FieldByName('TALLER').asString;
     Panels[6].Text:=' '+DMFicha.IBFicha.FieldByName('TURNO').asString;
   end;
end;

procedure TDMFicha.DataModuleCreate(Sender: TObject);
begin
   IBTLocal_Ficha.StartTransaction;
   FOriginalSQL := IBFicha.SelectSQL.Text;
end;

procedure TDMFicha.DataModuleDestroy(Sender: TObject);
begin
  IBTLocal_Ficha.Commit;
end;

procedure TDMFicha.Buscar(Campo, Texto : string);
begin
 if (TallerFicha<>'') and (TallerNomina='') then FOriginalSQL:='SELECT * FROM '+TallerFicha;
 if (TallerFicha='') and (TallerNomina<>'') then FOriginalSQL:='SELECT * FROM '+TallerNomina;
 if (TallerFicha<>'') and (TallerNomina<>'') then FOriginalSQL:='SELECT * FROM '+TallerFicha;
  With IBFicha do
   try
      // Desconectamos los controles
      DisableControls;
      // Cerramos
      Close ;
      // Restablecemos la sentencia original
      SelectSQL.Clear;
      SelectSQL.Add(FOriginalSQL);
      // Si no se ha de buscar nada, se abre la tabla y se sale
      if Texto = '' then
      begin
         Open;
         Last;
         First;
         Exit;
      end;
      SelectSQL.Add('WHERE '+Campo+' LIKE '+QuotedStr(Texto+ '%'));
      // Ordenamos por el campo que se hace la busqueda
      SelectSQL.Add('ORDER BY '+Campo);
      Open ;
   finally
      // Conectamos los controles
      EnableControls;
   end;
end;

procedure TDMFicha.Ordena(Campo, Orientacion: String);
var
  I: integer;
begin
  with IBFicha do
    try
       DisableControls;
       Close;
       for I:=SelectSQL.Count - 1 downto 0 do
         if pos('ORDER BY', uppercase(SelectSQL[i])) <> 0 then SelectSQL.Delete(I);
       SelectSQL.Add('ORDER BY '+Campo+Orientacion);
       Open;
       Last;
       First;
    finally
       EnableControls;
    end;
end;

procedure TDMFicha.Calcular_HorasTrabajadas;
var
  Numero_Jornadas: integer;
begin
   {CÁLCULO DE LAS HORAS REALES}
   {Se cuentan las X y se multiplica por 4 horas si el turno es M o T; o por 8 si es M-T}
   Numero_Jornadas:=0;
   if DMFicha.IBFichaDIA_1.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_2.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_3.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_4.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_5.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_6.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_7.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_8.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_9.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_10.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_11.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_12.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_13.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_14.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_15.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_16.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_17.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_18.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_19.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_20.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_21.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_22.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_23.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_24.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_25.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_26.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_27.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_28.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_29.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_30.AsString ='X' then Inc(Numero_Jornadas);
   if DMFicha.IBFichaDIA_31.AsString ='X' then Inc(Numero_Jornadas);
   DMFicha.IBFicha.Edit;
   if DMFicha.IBFichaTURNO.AsString ='M' then DMFicha.IBFichaHORAS_REALES.AsInteger:= (Numero_Jornadas*4);
   if DMFicha.IBFichaTURNO.AsString ='T' then DMFicha.IBFichaHORAS_REALES.AsInteger:= (Numero_Jornadas*4);
   if DMFicha.IBFichaTURNO.AsString ='M-T' then DMFicha.IBFichaHORAS_REALES.AsInteger:= (Numero_Jornadas*8);
   DMFicha.IBFicha.Post;
end;

procedure TDMFicha.IBFichaBeforeInsert(DataSet: TDataSet);
begin
{Para impedir que desde el WFicha.DbGrid cuando estas con los cursores y llegas
 al ultimo te añada un registro en blanco. 
{if WFicha.GLista.Focused then abort;
if WNomina.GListaN.Focused then abort;}
end;

Última edición por gorsan fecha: 19-03-2014 a las 23:17:15.
Responder Con Cita