This repository has been archived on 2024-11-29. You can view files and clone it, but cannot push or open issues or pull requests.
Tecsitel_FactuGES/Informes/InformeAlbaranCliente.pas
2007-06-21 15:47:20 +00:00

359 lines
12 KiB
ObjectPascal

{
===============================================================================
Copyright (©) 2001. Rodax Software.
===============================================================================
Los contenidos de este fichero son propiedad de Rodax Software titular del
copyright. Este fichero sólo podrá ser copiado, distribuido y utilizado,
en su totalidad o en parte, con el permiso escrito de Rodax Software, o de
acuerdo con los términos y condiciones establecidas en el acuerdo/contrato
bajo el que se suministra.
-----------------------------------------------------------------------------
Web: www.rodax-software.com
===============================================================================
Fecha primera versión: 01-10-2001
Versión actual: 1.0.5
Fecha versión actual: 08-03-2004
===============================================================================
Modificaciones:
Fecha Comentarios
---------------------------------------------------------------------------
27-11-2001 Se han añadido las unidades de medida.
15-01-2002 Imprimir la provincia del cliente junto con el resto
de la dirección.
18-01-2002 Ya no se rellena con filas vacias cuando los detalles
no cubren todas las hojas.
07-04-2002 Se ha adaptado para la transacción única.
08-03-2004 p272. Adaptación a multiempresa.
===============================================================================
}
unit InformeAlbaranCliente;
interface
uses
classes, AHWord97, IB, IBCustomDataSet, Ibdatabase, Mensajes;
type
TInformeAlbaranCliente = class(TComponent)
private
sqlCabeceraAlbaran : TStrings;
sqlDetallesAlbaran : TStrings;
FWordApp : TWordApp;
FDocumento : TWordDoc;
FTablaAlbaranes : TIBDataSet;
FTablaDetallesAlbaranes : TIBDataSet;
FTransaccion : TIBTransaction;
FBaseDatos : TIBDataBase;
FPlantilla : string;
FCodigoAlbaran : string;
FNombreFichero : string;
procedure IniciarSQLInformes;
procedure BuscarAlbaran;
function RellenarInforme (Codigo : String) : Boolean;
procedure RellenarDatosAlbaran;
procedure RellenarDatosDetalle;
function Generar(Codigo: String): Boolean;
public
function Exportar(Codigo, Fichero : String): Boolean;
function Imprimir(Codigo: String): Boolean;
constructor Create (AOwner : TComponent); override;
destructor Destroy; override;
end;
implementation
{ TInformeAlbaranCliente }
uses
BaseDatos, TablaAlbaranesCliente, DB, Sysutils, Controls,
Configuracion, Forms, StrFunc, Word2000, RdxEmpresaActiva,
Constantes, Literales, SysFunc;
procedure TInformeAlbaranCliente.BuscarAlbaran;
begin
if FTransaccion = NIL then
exit;
try
FTablaAlbaranes.Close;
FTablaDetallesAlbaranes.Close;
// Buscar la fila a tratar si es necesario
if not EsCadenaVacia(FCodigoAlbaran) then
begin
FTablaAlbaranes.Params.ByName('CODIGOEMPRESA').AsInteger := EmpresaActiva.Codigo;
FTablaAlbaranes.Params.ByName('CODIGO').AsString := FCodigoAlbaran;
FTablaDetallesAlbaranes.Params.ByName('CODIGOEMPRESA').AsInteger := EmpresaActiva.Codigo;
FTablaDetallesAlbaranes.Params.ByName('CODIGOALBARAN').AsString := FCodigoAlbaran;
end;
FTablaAlbaranes.Prepare;
FTablaDetallesAlbaranes.Prepare;
FTablaAlbaranes.Open;
FTablaDetallesAlbaranes.Open;
dmTablaAlbaranesCliente.InicializarTablaAlbaranes(@FTablaAlbaranes);
dmTablaAlbaranesCliente.InicializarTablaDetalles(@FTablaDetallesAlbaranes);
except
on E : EIBError do begin
VerMensaje(E.Message);
end;
on E : EDatabaseError do begin
VerMensaje(E.Message);
end;
end;
end;
constructor TInformeAlbaranCliente.Create(AOwner: TComponent);
begin
inherited;
FPlantilla := ExtractFileDir(ParamStr(0)) + '\informes\' + IntToStr(EmpresaActiva.ModeloInforme) + '\AlbaranCliente.rdx';
sqlCabeceraAlbaran := TStringList.Create;
sqlDetallesAlbaran := TStringList.Create;
IniciarSQLInformes;
FBaseDatos := dmBaseDatos.BD;
FTransaccion := dmBaseDatos.Transaccion;
FTablaAlbaranes := TIBDataSet.Create(Self);
FTablaDetallesAlbaranes := TIBDataSet.Create(Self);
with FTablaAlbaranes do
begin
Database := FBaseDatos;
Transaction := FTransaccion;
SelectSQL.Assign(sqlCabeceraAlbaran);
end;
with FTablaDetallesAlbaranes do
begin
Database := FBaseDatos;
Transaction := FTransaccion;
SelectSQL.Assign(sqlDetallesAlbaran);
end;
end;
destructor TInformeAlbaranCliente.Destroy;
begin
FTablaAlbaranes.Close;
FTablaDetallesAlbaranes.Close;
FTablaAlbaranes.UnPrepare;
FTablaDetallesAlbaranes.Unprepare;
FTablaAlbaranes.Free;
FTablaDetallesAlbaranes.Free;
FTablaAlbaranes := NIL;
FTablaDetallesAlbaranes := NIL;
FTransaccion := NIL;
FBaseDatos := NIL;
FDocumento := NIL;
sqlCabeceraAlbaran.Free;
sqlDetallesAlbaran.Free;
inherited;
end;
function TInformeAlbaranCliente.Generar(Codigo: String): Boolean;
begin
if EsCadenaVacia(Codigo) then
raise Exception.Create(msgInfFaltaCodAlb);
FCodigoAlbaran := Codigo;
Screen.Cursor := crHourglass;
FWordApp := TWordApp.Create (False, True);
with FWordApp do
begin
{ OnQuit := WordAppQuit;
OnChangeDocument := WordDocChange;
OnOpenDocument := WordDocOpen;
OnPreCloseDocument := WordPreClose;
OnCloseDocument := WordDocClose;
}
Visible := False;
end;
FDocumento := TWordDoc.CreateOpenDoc (FWordApp, FPlantilla);
try
if not RellenarInforme(Codigo) then
begin
Result := False;
Exit;
end;
FDocumento.SaveAs(FNombreFichero);
FWordApp.CloseApp(wdDoNotSaveChanges);
Result := True;
finally
FDocumento := NIL;
FWordApp := NIL;
Screen.Cursor := crArrow;
end;
end;
function TInformeAlbaranCliente.RellenarInforme(Codigo: String): Boolean;
begin
BuscarAlbaran;
with FDocumento do
begin
RellenarDatosAlbaran;
RellenarDatosDetalle;
end;
Result := True;
end;
procedure TInformeAlbaranCliente.RellenarDatosAlbaran;
var
FicheroTemporal : String;
LinkToFile, SaveWithDocument, _Range : OleVariant;
Imagen : InlineShape;
begin
//PARA DIBUJAR EL LOGOTIPO MULTIEMPRESA
if (EmpresaActiva.Logotipo <> Nil) then
begin
//Activamos cabecera
FWordApp.Application.ActiveWindow.ActivePane.View.SeekView := wdSeekCurrentPageHeader;
LinkToFile := False;
SaveWithDocument := True;
_Range := EmptyParam;
FicheroTemporal := DarFicheroTemporal;
EmpresaActiva.Logotipo.SaveToFile (FicheroTemporal);
Imagen := FWordApp.Application.ActiveWindow.ActivePane.Selection.InlineShapes.AddPicture(ficherotemporal, LinkToFile, SaveWithDocument, _Range);
//Formateamos imagen
if ((Imagen.Get_Width > ANCHO_LOGO_INF)) then
begin
Imagen.Set_Height(((ANCHO_LOGO_INF * Imagen.Get_Height) /Imagen.Get_Width));
Imagen.Set_Width(ANCHO_LOGO_INF);
end;
end;
with FDocumento, FTablaAlbaranes do
begin
ReplaceBookmark('CodigoAlbaranCab', FieldByName('CODIGO').AsString);
ReplaceBookmark('FechaAlbaranCab', FieldByName('FECHAALTA').AsString);
ReplaceBookmark('NombreClienteCab', FieldByName('NOMBRE').AsString);
ReplaceBookmark('DireccionClienteCab',
FieldByName('CALLE').AsString + ', ' + FieldByName('NUMERO').AsString +
' ' + FieldByName('PISO').AsString);
ReplaceBookmark('PoblacionClienteCab',
FieldByName('CODIGOPOSTAL').AsString + ' ' +
FieldByName('POBLACION').AsString + ' ' + FieldByName('PROVINCIA').AsString);
ReplaceBookmark('ContactoClienteCab', FieldByName('PERSONACONTACTO').AsString);
{P571
ReplaceBookmark('BaseImponible', FieldByName('BASEIMPONIBLE').DisplayText);
if esCadenaVacia(FieldByName('Descuento').DisplayText)
then ReplaceBookmark('Descuento', '0')
else ReplaceBookmark('Descuento', FieldByName('DESCUENTO').DisplayText);
ReplaceBookmark('ImporteDescuento', FieldByName('IMPORTEDESCUENTO').DisplayText);
if esCadenaVacia(FieldByName('IVA').DisplayText)
then ReplaceBookmark('IVA', '0')
else ReplaceBookmark('IVA', FieldByName('IVA').DisplayText);
ReplaceBookmark('ImporteIVA', FieldByName('IMPORTEIVA').DisplayText);
ReplaceBookmark('ImporteTotal', FieldByName('IMPORTETOTAL').DisplayText);
}
ReplaceBookmark('NombreEmpresa', EmpresaActiva.Nombre);
ReplaceBookmark('CifEmpresa', EmpresaActiva.NifCif);
ReplaceBookmark('DireccionEmpresa',
Format('%s, %s. %s %s', [EmpresaActiva.Calle, EmpresaActiva.Numero,
EmpresaActiva.CodigoPostal, EmpresaActiva.Poblacion]));
ReplaceBookmark('TelefonoEmpresa', EmpresaActiva.Telefono);
ReplaceBookmark('FaxEmpresa', EmpresaActiva.Fax);
ReplaceBookmark('CorreoEmpresa', EmpresaActiva.Correo);
end;
end;
procedure TInformeAlbaranCliente.RellenarDatosDetalle;
var
numRows, numCols, mergesplit : OleVariant;
MaxCols, iRowCount : Integer;
begin
iRowCount := 2;
numrows := 2;
numcols := 1;
mergeSplit := False;
MaxCols := 24;
with FDocumento.Document.Tables.Item(1), FTablaDetallesAlbaranes do
begin
FTablaDetallesAlbaranes.First;
while not FTablaDetallesAlbaranes.EOF do
begin
Rows.Item (iRowCount).Cells.Split (numRows, numCols, mergesplit);
Cell(iRowCount, 1).Range.Text := FieldByName('CODIGOARTICULO').AsString;
Cell(iRowCount, 2).Range.Text := FieldByName('DESCRIPCION').AsString;
Cell(iRowCount, 3).Range.Text := FieldByName('CANTIDAD').AsString + ' ' +
FieldByName('UNIDADESMEDIDA').AsString;
if (FieldByName('PRECIOUNIDAD').AsFloat = 0)
then Cell(iRowCount, 4).Range.Text := ''
else Cell(iRowCount, 4).Range.Text := FieldByName('PRECIOUNIDAD').DisplayText;
if (FieldByName('TOTAL').AsFloat = 0)
then Cell(iRowCount, 5).Range.Text := ''
else Cell(iRowCount, 5).Range.Text := FieldByName('TOTAL').DisplayText;
Next;
Inc (iRowCount);
end;
Rows.Item(iRowCount).Delete;
{while iRowCount <= MaxCols do
begin
Rows.Item (iRowCount).Cells.Split (numRows, numCols, mergesplit);
inc (iRowCount);
end;}
end;
end;
procedure TInformeAlbaranCliente.IniciarSQLInformes;
begin
with sqlCabeceraAlbaran do
begin
Add('select * from ALBARANESCLIENTE ');
Add('where (CODIGO = :CODIGO)');
Add('and (CODIGOEMPRESA = :CODIGOEMPRESA)');
end;
with sqlDetallesAlbaran do
begin
Add('select CODIGOALBARAN, NUMCONCEPTO, CODIGOARTICULO, DESCRIPCION, ');
Add('CANTIDAD, UNIDADESMEDIDA, PRECIOUNIDAD, TOTAL ');
Add('from DETALLESALBARANESCLIENTE ');
Add('where (CODIGOALBARAN = :CODIGOALBARAN) ');
Add('and (CODIGOEMPRESA = :CODIGOEMPRESA)');
Add('order by NUMCONCEPTO');
end;
end;
function TInformeAlbaranCliente.Exportar(Codigo,
Fichero: String): Boolean;
begin
if EsCadenaVacia(Fichero) then
begin
Result := False;
raise Exception.Create(msgInfFaltaFicheroListado);
end;
FNombreFichero := Fichero;
Result := Generar(Codigo);
end;
function TInformeAlbaranCliente.Imprimir(Codigo: String): Boolean;
begin
FNombreFichero := DarFicheroTemporal;
if not Generar(Codigo) then
begin
Result := False;
Exit;
end;
Result := ImprimirDoc(FNombreFichero);
DeleteFile(FNombreFichero);
end;
end.