Archivado/LuisLeon_FactuGES
Archived
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Ticket #14 -> Poder enviar facturas por correo electrónico

Browse Source 
git-svn-id: https://192.168.0.254/svn/Proyectos.LuisLeon_FactuGES/trunk@286 c93665c3-c93d-084d-9b98-7d5f4a9c3376
This commit is contained in:
David Arranz 2008-09-22 16:09:44 +00:00
parent 8e748ddc7f
commit e918358544
75 changed files with 5245 additions and 771 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
Build/Build.fbp5
View File

@ -287,7 +287,7 @@ source_path
<Property MultiValue="0" name="ActionTypeID" type="string"></Property>
<Property MultiValue="1" name="Description" type="string"><![CDATA[Borrar ficheros temporales]]>
</Property>
<Property name="Enabled" type="WordBool">True</Property>
<Property name="Enabled" type="WordBool">False</Property>
<Property name="ExpandActionLogTitle" type="Boolean">True</Property>
<Property name="IgnoreFailure" type="WordBool">False</Property>
<Property name="IsAction" type="Boolean">True</Property>
@ -530,7 +530,7 @@ source_path
<Property name="IsBreakPoint" type="WordBool">False</Property>
<Property MultiValue="0" name="LogToVariable" type="string"></Property>
<Property name="MaxRetryAttempts" type="Cardinal">0</Property>
<Property name="NodeCollapsed" type="Boolean">True</Property>
<Property name="NodeCollapsed" type="Boolean">False</Property>
<Property name="PauseInterval" type="Cardinal">0</Property>
<Property name="RetryPauseInterval" type="Cardinal">1000</Property>
<Property name="SuppressStatusMessages" type="Boolean">False</Property>
@ -579,7 +579,7 @@ source_path
<Property name="PauseInterval" type="Cardinal">0</Property>
<Property MultiValue="0" name="ProjectFile" type="WideString">%source_path%\Servidor\FactuGES_Server.dpr</Property>
<Property name="RegenerateResource" type="WordBool">True</Property>
<Property name="ReleaseVersion" type="Integer">2</Property>
<Property name="ReleaseVersion" type="Integer">5</Property>
<Property MultiValue="0" name="ResourceCompilerOptions" type="string"></Property>
<Property MultiValue="0" name="ResourceCompilerPath" type="string"></Property>
<Property name="ResourceCompilerType" type="TFBDelphiResourceCompiler">rcBorland</Property>
@ -594,15 +594,15 @@ source_path
<Property name="UseVersionFromDOF" type="Boolean">True</Property>
<Property MultiValue="1" name="VersionInfoKeys" type="WideString"><![CDATA[CompanyName=Rodax Software S.L.
FileDescription=
FileVersion=3.0.2.0
FileVersion=3.0.5.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=FactuGES Server
ProductVersion=3.0.2.0
ProductVersion=3.0.5.0
Comments=
CompileDate=
CompileDate=martes, 15 de julio de 2008 19:13
]]>
</Property>
<Property MultiValue="0" name="VersionInfoPropertySetName" type="string"></Property>
@ -20604,7 +20604,7 @@ Comments=
<Property name="PauseInterval" type="Cardinal">0</Property>
<Property MultiValue="0" name="ProjectFile" type="WideString">%source_path%\Cliente\FactuGES.dpr</Property>
<Property name="RegenerateResource" type="WordBool">True</Property>
<Property name="ReleaseVersion" type="Integer">2</Property>
<Property name="ReleaseVersion" type="Integer">5</Property>
<Property MultiValue="0" name="ResourceCompilerOptions" type="string"></Property>
<Property MultiValue="0" name="ResourceCompilerPath" type="string"></Property>
<Property name="ResourceCompilerType" type="TFBDelphiResourceCompiler">rcBorland</Property>
@ -20619,13 +20619,13 @@ Comments=
<Property name="UseVersionFromDOF" type="Boolean">False</Property>
<Property MultiValue="1" name="VersionInfoKeys" type="WideString"><![CDATA[CompanyName=Rodax Software S.L.
FileDescription=
FileVersion=3.0.2.0
FileVersion=3.0.5.0
InternalName=FactuGES
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=3.0.2.0
ProductVersion=3.0.5.0
Comments=
]]>
</Property>

BIN
Database/FACTUGES.FDB
View File

Binary file not shown.

87
Database/VISTAS.SQL
View File

@ -184,7 +184,8 @@ CREATE VIEW V_CLIENTES(
ID_FORMA_PAGO,
TIENDA_WEB,
AGENTE,
RAPEL)
RAPEL,
EMAIL_ADMINISTRACION)
AS
SELECT
V_CONTACTOS.ID,
@ -221,7 +222,8 @@ SELECT
CLIENTES_DATOS.ID_FORMA_PAGO,
CLIENTES_DATOS.TIENDA_WEB,
CONTACTOS.NOMBRE AS AGENTE,
CLIENTES_DATOS.RAPEL
CLIENTES_DATOS.RAPEL,
CLIENTES_DATOS.EMAIL_ADMINISTRACION
FROM
V_CONTACTOS
LEFT OUTER JOIN CLIENTES_DATOS ON (V_CONTACTOS.ID = CLIENTES_DATOS.ID_CLIENTE)
@ -257,7 +259,8 @@ CREATE VIEW V_PROVEEDORES(
REGIMEN_IVA,
ID_TIPO_IVA,
ID_FORMA_PAGO,
TIENDA_WEB)
TIENDA_WEB,
EMAIL_ADMINISTRACION)
AS
SELECT
V_CONTACTOS.ID,
@ -286,7 +289,8 @@ SELECT
PROVEEDORES_DATOS.REGIMEN_IVA,
PROVEEDORES_DATOS.ID_TIPO_IVA,
PROVEEDORES_DATOS.ID_FORMA_PAGO,
PROVEEDORES_DATOS.TIENDA_WEB
PROVEEDORES_DATOS.TIENDA_WEB,
PROVEEDORES_DATOS.EMAIL_ADMINISTRACION
FROM
PROVEEDORES_DATOS
INNER JOIN V_CONTACTOS ON (PROVEEDORES_DATOS.ID_PROVEEDOR = V_CONTACTOS.ID)
@ -869,40 +873,41 @@ SELECT FACTURAS_PROVEEDOR.ID,
CREATE VIEW V_FACTURAS_CLIENTE(
ID,
ID_EMPRESA,
REFERENCIA,
TIPO,
ID_COMISION_LIQUIDADA,
FECHA_FACTURA,
SITUACION,
BASE_IMPONIBLE,
DESCUENTO,
IMPORTE_DESCUENTO,
IVA,
IMPORTE_IVA,
RE,
IMPORTE_RE,
IMPORTE_TOTAL,
OBSERVACIONES,
ID_CLIENTE,
NIF_CIF,
NOMBRE,
CALLE,
POBLACION,
PROVINCIA,
CODIGO_POSTAL,
FECHA_ALTA,
FECHA_MODIFICACION,
USUARIO,
ID_FORMA_PAGO,
RECARGO_EQUIVALENCIA,
ID_TIPO_IVA,
IMPORTE_NETO,
IMPORTE_PORTE,
ID_AGENTE,
REFERENCIA_COMISION,
NUM_COPIAS)
ID,
ID_EMPRESA,
REFERENCIA,
TIPO,
ID_COMISION_LIQUIDADA,
FECHA_FACTURA,
SITUACION,
BASE_IMPONIBLE,
DESCUENTO,
IMPORTE_DESCUENTO,
IVA,
IMPORTE_IVA,
RE,
IMPORTE_RE,
IMPORTE_TOTAL,
OBSERVACIONES,
ID_CLIENTE,
NIF_CIF,
NOMBRE,
CALLE,
POBLACION,
PROVINCIA,
CODIGO_POSTAL,
FECHA_ALTA,
FECHA_MODIFICACION,
USUARIO,
ID_FORMA_PAGO,
RECARGO_EQUIVALENCIA,
ID_TIPO_IVA,
IMPORTE_NETO,
IMPORTE_PORTE,
ID_AGENTE,
REFERENCIA_COMISION,
NUM_COPIAS,
NUM_CORREOS)
AS
SELECT FACTURAS_CLIENTE.ID,
FACTURAS_CLIENTE.ID_EMPRESA,
@ -946,7 +951,9 @@ SELECT FACTURAS_CLIENTE.ID,
LEFT JOIN CLIENTES_DATOS
ON (CLIENTES_DATOS.ID_CLIENTE = FACTURAS_CLIENTE.ID_CLIENTE)
LEFT JOIN IMPRESIONES
ON ((IMPRESIONES.ID_TABLA = FACTURAS_CLIENTE.ID) AND (IMPRESIONES.TABLA = 'FACTURASCLIENTE'));
ON ((IMPRESIONES.ID_TABLA = FACTURAS_CLIENTE.ID) AND (IMPRESIONES.TABLA = 'FACTURASCLIENTE'))
LEFT JOIN REGISTRO_CORREOS
ON ((REGISTRO_CORREOS.ID_TABLA = FACTURAS_CLIENTE.ID) AND (REGISTRO_CORREOS.TABLA = 'FACTURASCLIENTE'));
@ -2770,4 +2777,4 @@ on ((AGENTES_COMISIONES.ID_AGENTE = AGENTES.ID) and (AGENTES_COMISIONES.ID_PROVE
where (FACTURAS_CLIENTE_DETALLES.ID_ARTICULO is not null) and (FACTURAS_CLIENTE_DETALLES.ID_ARTICULO > 0) /*Quitamos conceptos libres*/
/*and (FACTURAS_CLIENTE_DETALLES.cantidad > 0) Quitamos los abonos*/
and (ARTICULOS.INVENTARIABLE = 1);
and (ARTICULOS.INVENTARIABLE = 1);

62
Database/factuges.sql
View File

@ -61,6 +61,7 @@ VARCHAR(20);
/******************************************************************************/
CREATE GENERATOR GEN_IMPRESIONES_ID;
CREATE GENERATOR GEN_REGISTRO_CORREOS_ID;
CREATE GENERATOR GEN_AGENTES_COMISIONES_ID;
CREATE GENERATOR GEN_ALBARANES_CLI_DETALLES_ID;
CREATE GENERATOR GEN_ALBARANES_CLI_ID;
@ -107,10 +108,17 @@ CREATE GENERATOR GEN_USUARIOS_ID;
/******************************************************************************/
CREATE TABLE IMPRESIONES(
ID TIPO_ID NOT NULL,
ID_TABLA TIPO_ID,
TABLA VARCHAR(50) COLLATE ES_ES,
NUM_COPIAS SMALLINT
ID TIPO_ID NOT NULL,
ID_TABLA TIPO_ID,
TABLA VARCHAR(50) COLLATE ES_ES,
NUM_COPIAS SMALLINT
);
CREATE TABLE REGISTRO_CORREOS (
ID TIPO_ID NOT NULL /* TIPO_ID = INTEGER */,
ID_TABLA TIPO_ID /* TIPO_ID = INTEGER */,
TABLA VARCHAR(50) COLLATE ES_ES,
NUM_CORREOS SMALLINT
);
@ -297,7 +305,8 @@ CREATE TABLE CLIENTES_DATOS (
ID_TIPO_IVA TIPO_ID,
ID_FORMA_PAGO TIPO_ID,
TIENDA_WEB TIPO_BOOLEANO,
RAPEL SMALLINT
RAPEL SMALLINT,
EMAIL_ADMINISTRACION VARCHAR(255)
);
@ -756,7 +765,8 @@ CREATE TABLE PROVEEDORES_DATOS (
REGIMEN_IVA VARCHAR(255),
ID_TIPO_IVA TIPO_ID,
ID_FORMA_PAGO TIPO_ID,
TIENDA_WEB TIPO_BOOLEANO
TIENDA_WEB TIPO_BOOLEANO,
EMAIL_ADMINISTRACION VARCHAR(255)
);
@ -1042,6 +1052,7 @@ ALTER TABLE REMESAS_PROVEEDOR ADD CONSTRAINT PK_REMESAS_PROVEEDOR PRIMARY KEY (I
ALTER TABLE TIENDA_WEB ADD CONSTRAINT PK_TIENDA_WEB PRIMARY KEY (ID);
ALTER TABLE TIPOS_IVA ADD PRIMARY KEY (ID);
ALTER TABLE USUARIOS ADD CONSTRAINT PK_USUARIOS PRIMARY KEY (ID);
ALTER TABLE REGISTRO_CORREOS ADD CONSTRAINT PK_REGISTRO_CORREOS PRIMARY KEY (ID);
/******************************************************************************/
@ -1089,6 +1100,8 @@ ALTER TABLE TIENDA_WEB ADD CONSTRAINT FK_EMPRESAS_TIENDA_WEB FOREIGN KEY (ID_EMP
CREATE INDEX IMPRESIONES_IDX1 ON IMPRESIONES(ID_TABLA);
CREATE INDEX IMPRESIONES_IDX2 ON IMPRESIONES(TABLA);
CREATE INDEX REGISTRO_CORREOS_IDX1 ON REGISTRO_CORREOS (ID_TABLA);
CREATE INDEX REGISTRO_CORREOS_IDX2 ON REGISTRO_CORREOS (TABLA);
CREATE INDEX IDX_AGENTES_COMISIONES1 ON AGENTES_COMISIONES (ID_AGENTE);
CREATE INDEX IDX_AGENTES_COMISIONES2 ON AGENTES_COMISIONES (ID_PROVEEDOR);
CREATE INDEX ALBARANES_CLIENTE_IDX1 ON ALBARANES_CLIENTE (TIPO);
@ -1687,4 +1700,39 @@ begin
values (GEN_ID(GEN_IMPRESIONES_ID, 1), UPPER(:TABLA), :ID_TABLA, 1);
end
suspend;
end;
end;
SET TERM ^ ;
CREATE PROCEDURE PRO_ANADIR_MARCA_ENVIO_CORREO (
tabla varchar(255),
id_tabla integer)
as
declare variable id integer;
begin
select ID
from REGISTRO_CORREOS
where ID_TABLA = :ID_TABLA
and TABLA = UPPER(:TABLA)
into :ID;
/*En el caso de que ya exista se modifica la cantidad en caso contrario se anade el elemento */
if (ID > 0) then
begin
update REGISTRO_CORREOS
set NUM_CORREOS = NUM_CORREOS + 1
where ID = :ID;
end
else
begin
insert into REGISTRO_CORREOS (ID, TABLA, ID_TABLA, NUM_CORREOS)
values (GEN_ID(GEN_REGISTRO_CORREOS_ID, 1), UPPER(:TABLA), :ID_TABLA, 1);
end
suspend;
end^
SET TERM ; ^
GRANT SELECT,INSERT,UPDATE ON REGISTRO_CORREOS TO PROCEDURE PRO_ANADIR_MARCA_ENVIO_CORREO;
GRANT EXECUTE ON PROCEDURE PRO_ANADIR_MARCA_ENVIO_CORREO TO SYSDBA;

4
Source/Base/Base.dpk
View File

@ -103,6 +103,8 @@ contains
uInfoProjectUtils in 'Utiles\uInfoProjectUtils.pas',
uInformeRegistryUtils in 'ClassRegistry\uInformeRegistryUtils.pas',
uStringsUtils in 'Utiles\uStringsUtils.pas',
uDataModuleImpresiones in '..\Modulos\Impresiones\Data\uDataModuleImpresiones.pas' {dmImpresiones: TDataModule};
uDataModuleImpresiones in '..\Modulos\Impresiones\Data\uDataModuleImpresiones.pas' {dmImpresiones: TDataModule},
uEMailUtils in 'Utiles\uEMailUtils.pas',
uDataModuleRegistroCorreos in '..\Modulos\Registro de correos\Data\uDataModuleRegistroCorreos.pas' {dmRegistroCorreos: TDataModule};
end.

BIN
Source/Base/Base.res
View File

Binary file not shown.

7
Source/Base/GUIBase/GUIBase.dpk
View File

@ -82,7 +82,8 @@ requires
PNG_D10,
PngComponentsD10,
ControllerBase,
cxIntlPrintSys3D10;
cxIntlPrintSys3D10,
dxGDIPlusD10;
contains
uEditorBase in 'uEditorBase.pas' {fEditorBase: TCustomEditor},
@ -107,6 +108,8 @@ contains
uEditorBasico in 'uEditorBasico.pas' {fEditorBasico},
uDialogBase in 'uDialogBase.pas' {fDialogBase},
uViewFiltroBase in 'uViewFiltroBase.pas' {frViewFiltroBase: TFrame},
uViewGrid in 'uViewGrid.pas' {frViewGrid: TFrame};
uViewGrid in 'uViewGrid.pas' {frViewGrid: TFrame},
uDialogElegirEMail in 'uDialogElegirEMail.pas' {fDialogElegirEMail},
uDialogListaEnvioEMail in 'uDialogListaEnvioEMail.pas' {fDialogListaEnvioEMail};
end.

115
Source/Base/GUIBase/uDialogElegirEMail.dfm Normal file
View File

@ -0,0 +1,115 @@
inherited fDialogElegirEMail: TfDialogElegirEMail
Caption = 'Elegir direcci'#243'n de correo electr'#243'nico'
ClientHeight = 258
ClientWidth = 533
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnDestroy = FormDestroy
ExplicitWidth = 539
ExplicitHeight = 283
PixelsPerInch = 96
TextHeight = 13
inherited pnlBotones: TFlowPanel
Top = 202
Width = 533
ExplicitTop = 202
ExplicitWidth = 533
inherited Button1: TButton
Left = 437
ExplicitLeft = 437
end
inherited Button2: TButton
Left = 347
ExplicitLeft = 347
end
end
inherited FlowPanel1: TFlowPanel
Width = 533
Height = 202
ExplicitWidth = 533
ExplicitHeight = 202
inherited lblInstruccion: TLabel
Width = 477
Caption = 'Indique la direcci'#243'n de correo electr'#243'nico del destinatario:'
Font.Style = [fsBold]
ExplicitWidth = 477
end
inherited Label2: TLabel
Width = 490
Height = 45
Caption =
'Para enviar el correo, puede usar la direcci'#243'n administrativa (s' +
'i el cliente la tiene en su ficha) o indicar otra direcci'#243'n dist' +
'inta con la segunda opci'#243'n.'
WordWrap = True
ExplicitWidth = 490
ExplicitHeight = 45
end
object Panel1: TPanel
Left = 31
Top = 115
Width = 482
Height = 80
Align = alClient
BevelOuter = bvNone
ParentColor = True
TabOrder = 0
object rbCombo: TRadioButton
Tag = 1
Left = 10
Top = 6
Width = 170
Height = 17
Caption = 'Usar la direcci'#243'n administrativa:'
TabOrder = 0
OnClick = rbComboClick
end
object cbEMail: TComboBox
Left = 211
Top = 6
Width = 262
Height = 21
Style = csDropDownList
ItemHeight = 13
TabOrder = 1
end
object rbEdit: TRadioButton
Tag = 2
Left = 10
Top = 41
Width = 202
Height = 17
Caption = 'Usar la siguiente direcci'#243'n de correo:'
TabOrder = 2
OnClick = rbEditClick
end
object edtEMail: TcxHyperLinkEdit
Left = 211
Top = 39
Properties.UsePrefix = upNever
Properties.ValidateOnEnter = True
Properties.Prefix = ''
Style.LookAndFeel.Kind = lfStandard
Style.LookAndFeel.NativeStyle = True
StyleDisabled.LookAndFeel.Kind = lfStandard
StyleDisabled.LookAndFeel.NativeStyle = True
StyleFocused.LookAndFeel.Kind = lfStandard
StyleFocused.LookAndFeel.NativeStyle = True
StyleHot.LookAndFeel.Kind = lfStandard
StyleHot.LookAndFeel.NativeStyle = True
TabOrder = 3
Width = 262
end
end
end
inherited ActionList1: TActionList
Left = 8
Top = 8
inherited actAceptar: TAction
OnExecute = actAceptarExecute
end
inherited actCancelar: TAction
OnExecute = actCancelarExecute
end
end
end

173
Source/Base/GUIBase/uDialogElegirEMail.pas Normal file
View File

@ -0,0 +1,173 @@
unit uDialogElegirEMail;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, uDialogBase, ActnList, StdCtrls, ExtCtrls, cxControls, cxContainer,
cxEdit, cxTextEdit, cxHyperLinkEdit;
type
TfDialogElegirEMail = class(TfDialogBase)
Panel1: TPanel;
rbCombo: TRadioButton;
cbEMail: TComboBox;
rbEdit: TRadioButton;
edtEMail: TcxHyperLinkEdit;
procedure rbComboClick(Sender: TObject);
procedure rbEditClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure actAceptarExecute(Sender: TObject);
procedure actCancelarExecute(Sender: TObject);
private
FListaDirecciones: TStringList;
function GetEMailElegido: String;
procedure ActualizarOpciones;
public
property EMailElegido: String read GetEMailElegido;
property ListaDirecciones : TStringList read FListaDirecciones write FListaDirecciones;
end;
function ElegirEMail(const AListaEMails : TStringList; var AEMailElegido : String): Boolean;
implementation
{$R *.dfm}
uses
uStringsUtils, uDialogUtils, uEMailUtils;
function ElegirEMail(const AListaEMails : TStringList; var AEMailElegido : String): Boolean;
var
AEditor : TfDialogElegirEMail;
begin
AEditor := TfDialogElegirEMail.Create(NIL);
try
AEditor.ListaDirecciones := AListaEMails;
Result := (AEditor.ShowModal = mrOk);
if Result then
AEMailElegido := AEditor.EMailElegido;
finally
AEditor.Release;
end;
end;
{ TfDialogElegirEMail }
procedure TfDialogElegirEMail.actAceptarExecute(Sender: TObject);
begin
inherited;
ModalResult := mrOk
end;
procedure TfDialogElegirEMail.actCancelarExecute(Sender: TObject);
begin
inherited;
ModalResult := mrCancel;
end;
procedure TfDialogElegirEMail.ActualizarOpciones;
begin
if rbEdit.Checked then
begin
edtEMail.Enabled := True;
rbCombo.Checked := False;
cbEMail.Enabled := False;
end
else begin
if rbCombo.Enabled then
begin
cbEMail.Enabled := True;
edtEMail.Enabled := False;
rbEdit.Checked := False;
end
else
rbEdit.Checked := True;
end;
end;
procedure TfDialogElegirEMail.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
inherited;
if (ModalResult = mrOk) and rbEdit.Checked then
begin
if not EsCadenaVacia(edtEMail.Text) then
begin
if not EsDireccionEMailValida(edtEMail.Text) then
begin
ShowErrorMessage('La dirección de correo electrónica no es válida', 'Para poder continuar, compruebe que ha indicado una dirección de correo y que está bien escrita.');
edtEMail.SetFocus;
CanClose := False;
end;
end
else begin
ShowErrorMessage('Debe indicar una dirección de correo electrónico.', 'Para poder continuar debe elegir o indicar una dirección de correo electrónico.');
edtEMail.SetFocus;
CanClose := False;
end;
end;
end;
procedure TfDialogElegirEMail.FormCreate(Sender: TObject);
begin
inherited;
//FListaDirecciones := TStringList.Create; <- La lista se da mediante la propiedad.
end;
procedure TfDialogElegirEMail.FormDestroy(Sender: TObject);
begin
inherited;
//FreeAndNIL(FListaDirecciones) <- La lista se da mediante la propiedad.
end;
procedure TfDialogElegirEMail.FormShow(Sender: TObject);
begin
inherited;
cbEMail.Items.Clear;
cbEMail.Items := FListaDirecciones;
if cbEMail.Items.Count = 0 then
begin
cbEmail.Items.Add('Sin dirección administrativa');
cbEMail.ItemIndex := 0;
rbCombo.Enabled := False;
rbEdit.Checked;
end
else begin
cbEMail.ItemIndex := 0;
rbCombo.Checked := True;
end;
ActualizarOpciones;
end;
function TfDialogElegirEMail.GetEMailElegido: String;
begin
if rbCombo.Checked then
Result := cbEMail.Text
else
Result := edtEMail.Text;
end;
procedure TfDialogElegirEMail.rbComboClick(Sender: TObject);
begin
inherited;
rbEdit.Checked := False;
ActualizarOpciones;
end;
procedure TfDialogElegirEMail.rbEditClick(Sender: TObject);
begin
inherited;
rbEdit.Checked := True;
ActualizarOpciones;
end;
end.

29
Source/Base/GUIBase/uDialogListaEnvioEMail.dfm Normal file
View File

@ -0,0 +1,29 @@
inherited fDialogListaEnvioEMail: TfDialogListaEnvioEMail
Caption = 'fDialogListaEnvioEMail'
PixelsPerInch = 96
TextHeight = 13
inherited FlowPanel1: TFlowPanel
object ListView1: TListView
Left = 31
Top = 151
Width = 571
Height = 197
Align = alClient
Columns = <
item
Caption = 'Documento'
end
item
Caption = 'Destinatario'
end
item
Caption = 'Direcci'#243'n E-Mail'
end
item
Caption = 'Estado'
end>
TabOrder = 0
ViewStyle = vsReport
end
end
end

22
Source/Base/GUIBase/uDialogListaEnvioEMail.pas Normal file
View File

@ -0,0 +1,22 @@
unit uDialogListaEnvioEMail;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, uDialogBase, ActnList, StdCtrls, ExtCtrls, ComCtrls;
type
TfDialogListaEnvioEMail = class(TfDialogBase)
ListView1: TListView;
private
{ Private declarations }
public
{ Public declarations }
end;
implementation
{$R *.dfm}
end.

29
Source/Base/GUIBase/uViewGridBase.pas
View File

@ -36,6 +36,7 @@ type
procedure SaveGridStatus;
procedure RestoreGridStatus;
procedure DesactivarGrid;
procedure ActivarGrid;
@ -95,6 +96,7 @@ type
FFilter: string;
FOnFilterChanged : TNotifyEvent;
FGridStatus : TcxGridStatus;
procedure BestFitAllColumns;
protected
FOnDblClick: TNotifyEvent;
FPopupMenu: TPopupMenu;
@ -190,9 +192,34 @@ end;
procedure TfrViewGridBase.AjustarAncho;
begin
if Assigned(_FocusedView) then
_FocusedView.ApplyBestFit;
//_FocusedView.ApplyBestFit;
BestFitAllColumns;
end;
procedure TfrViewGridBase.BestFitAllColumns;
var
i : Integer ;
begin
ShowHourglassCursor;
_FocusedView.BeginUpdate;
try
for i := 0 to _FocusedView.ColumnCount-1 do
begin
_FocusedView.Columns[i].ApplyBestFit;
if _FocusedView.Columns[i].BestFitMaxWidth > 0 then
begin
if (_FocusedView.Columns[i].Width > _FocusedView.Columns[i].BestFitMaxWidth) then
_FocusedView.Columns[i].Width := _FocusedView.Columns[i].BestFitMaxWidth;
end;
end;
finally
_FocusedView.EndUpdate;
HideHourglassCursor;
end;
end;
procedure TfrViewGridBase.AnadirOtrosFiltros;
begin
//

457
Source/Base/Utiles/uEMailUtils.pas Normal file
View File

@ -0,0 +1,457 @@
unit uEMailUtils;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
{ Introducing a new Type of Event to get the Errorcode }
TMapiErrEvent = procedure(Sender: TObject; ErrCode: Integer) of object;
TMapiControl = class(TComponent)
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
private
{ Private-Deklarationen }
FSubject: string;
FMailtext: string;
FFromName: string;
FFromAdress: string;
FTOAdr: TStrings;
FCCAdr: TStrings;
FBCCAdr: TStrings;
FAttachedFileName: TStrings;
FDisplayFileName: TStrings;
FShowDialog: Boolean;
FUseAppHandle: Boolean;
{ Error Events: }
{ FOnUserAbort: TNotifyEvent;
FOnMapiError: TMapiErrEvent;
FOnSuccess: TNotifyEvent;}
{ +> Changes by Eugene Mayevski [mailto:Mayevski@eldos.org]}
procedure SetToAddr(newValue: TStrings);
procedure SetCCAddr(newValue: TStrings);
procedure SetBCCAddr(newValue: TStrings);
procedure SetAttachedFileName(newValue: TStrings);
{ +< Changes }
protected
{ Protected-Deklarationen }
public
{ Public-Deklarationen }
ApplicationHandle: THandle;
function Sendmail: Boolean;
procedure Reset;
published
{ Published-Deklarationen }
property Subject: string read FSubject write FSubject;
property Body: string read FMailText write FMailText;
property FromName: string read FFromName write FFromName;
property FromAdress: string read FFromAdress write FFromAdress;
property Recipients: TStrings read FTOAdr write SetTOAddr;
property CopyTo: TStrings read FCCAdr write SetCCAddr;
property BlindCopyTo: TStrings read FBCCAdr write SetBCCAddr;
property AttachedFiles: TStrings read FAttachedFileName write SetAttachedFileName;
property DisplayFileName: TStrings read FDisplayFileName;
property ShowDialog: Boolean read FShowDialog write FShowDialog;
property UseAppHandle: Boolean read FUseAppHandle write FUseAppHandle;
{ Events: }
{property OnUserAbort: TNotifyEvent read FOnUserAbort write FOnUserAbort;
property OnMapiError: TMapiErrEvent read FOnMapiError write FOnMapiError;
property OnSuccess: TNotifyEvent read FOnSuccess write FOnSuccess;}
end;
function EsDireccionEMailValida(const Value: string): boolean;
function EnviarEMailMAPI(const AAsunto, ACuerpo, AFicheroAdjunto, ANombreRemitente, AEMailRemitente,
ANombreDestinatario, AEMailDestinatario: String; AEnviarDirectamente: Boolean = false) : boolean;
implementation
uses
MAPI;
function EsDireccionEMailValida(const Value: string): boolean;
function CheckAllowed(const s: string): boolean;
var
i: integer;
begin
Result:= false;
for i:= 1 to Length(s) do
begin
// illegal char in s -> no valid address
if not (s[i] in ['a'..'z','A'..'Z','0'..'9','_','-','.']) then
Exit;
end;
Result:= true;
end;
var
i: integer;
namePart, serverPart: string;
begin // of IsValidEmail
Result:= false;
i:= Pos('@', Value);
if (i = 0) or (pos('..', Value) > 0) then
Exit;
namePart:= Copy(Value, 1, i - 1);
serverPart:= Copy(Value, i + 1, Length(Value));
if (Length(namePart) = 0) // @ or name missing
or ((Length(serverPart) < 4)) // name or server missing or
then Exit; // too short
i:= Pos('.', serverPart);
// must have dot and at least 3 places from end
if (i < 2) or (i > (Length(serverPart) - 2)) then
Exit;
Result:= CheckAllowed(namePart) and CheckAllowed(serverPart);
end;
function EnviarEMailMAPI(const AAsunto, ACuerpo, AFicheroAdjunto, ANombreRemitente, AEMailRemitente,
ANombreDestinatario, AEMailDestinatario: String; AEnviarDirectamente: Boolean = false) : boolean;
var
AMAPIControl : TMapiControl;
begin
AMAPIControl := TMapiControl.Create(NIL);
try
with AMAPIControl do
begin
Subject := AAsunto;
Body := ACuerpo;
FromName := ANombreRemitente;
FromAdress := AEMailRemitente;
Recipients.Add(AEMailDestinatario);
AttachedFiles.Add(AFicheroAdjunto);
ShowDialog := not AEnviarDirectamente;
end;
Result := AMAPIControl.Sendmail;
finally
FreeANDNIL(AMAPIControl);
end;
end;
{ TMapiControl }
constructor TMapiControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{FOnUserAbort := nil;
FOnMapiError := nil;
FOnSuccess := nil;}
FSubject := '';
FMailtext := '';
FFromName := '';
FFromAdress := '';
FTOAdr := TStringList.Create;
FCCAdr := TStringList.Create;
FBCCAdr := TStringList.Create;
FAttachedFileName := TStringList.Create;
FDisplayFileName := TStringList.Create;
FShowDialog := False;
ApplicationHandle := Application.Handle;
end;
{ +> Changes by Eugene Mayevski [mailto:Mayevski@eldos.org]}
procedure TMapiControl.SetToAddr(newValue: TStrings);
begin
FToAdr.Assign(newValue);
end;
procedure TMapiControl.SetCCAddr(newValue: TStrings);
begin
FCCAdr.Assign(newValue);
end;
procedure TMapiControl.SetBCCAddr(newValue: TStrings);
begin
FBCCAdr.Assign(newValue);
end;
procedure TMapiControl.SetAttachedFileName(newValue: TStrings);
begin
FAttachedFileName.Assign(newValue);
end;
{ +< Changes }
destructor TMapiControl.Destroy;
begin
FTOAdr.Free;
FCCAdr.Free;
FBCCAdr.Free;
FAttachedFileName.Free;
FDisplayFileName.Free;
inherited destroy;
end;
{ Reset the fields for re-use}
procedure TMapiControl.Reset;
begin
FSubject := '';
FMailtext := '';
FFromName := '';
FFromAdress := '';
FTOAdr.Clear;
FCCAdr.Clear;
FBCCAdr.Clear;
FAttachedFileName.Clear;
FDisplayFileName.Clear;
end;
{ Send the Mail via the API, this procedure composes and sends
the Email }
function TMapiControl.Sendmail: Boolean;
var
MapiMessage: TMapiMessage;
MError: Cardinal;
Sender: TMapiRecipDesc;
PRecip, Recipients: PMapiRecipDesc;
PFiles, Attachments: PMapiFileDesc;
i: Integer;
AppHandle: THandle;
begin
{ First we store the Application Handle, if not
the Component might fail to send the Email or
your calling Program gets locked up. }
AppHandle := Application.Handle;
{ Initialize the Attachment Pointer, to keep Delphi quiet }
PFiles := nil;
{ We need all recipients to alloc the memory }
MapiMessage.nRecipCount := FTOAdr.Count + FCCAdr.Count + FBCCAdr.Count;
GetMem(Recipients, MapiMessage.nRecipCount * sizeof(TMapiRecipDesc));
try
with MapiMessage do
begin
ulReserved := 0;
{ Setting the Subject: }
lpszSubject := PChar(Self.FSubject);
{ ... the Body: }
lpszNoteText := PChar(FMailText);
lpszMessageType := nil;
lpszDateReceived := nil;
lpszConversationID := nil;
flFlags := 0;
{ and the sender: (MAPI_ORIG) }
Sender.ulReserved := 0;
Sender.ulRecipClass := MAPI_ORIG;
Sender.lpszName := PChar(FromName);
Sender.lpszAddress := PChar(FromAdress);
Sender.ulEIDSize := 0;
Sender.lpEntryID := nil;
lpOriginator := @Sender;
PRecip := Recipients;
{ We have multiple recipients: (MAPI_TO)
and setting up each: }
if nRecipCount > 0 then
begin
for i := 1 to FTOAdr.Count do
begin
PRecip^.ulReserved := 0;
PRecip^.ulRecipClass := MAPI_TO;
{ lpszName should carry the Name like in the
contacts or the adress book, I will take the
email adress to keep it short: }
PRecip^.lpszName := PChar(FTOAdr.Strings[i - 1]);
{ If you use this component with Outlook97 or 2000
and not some of Express versions you will have to set
'SMTP:' in front of each (email-) adress. Otherwise
Outlook/Mapi will try to handle the Email on itself.
Sounds strange, just erease the 'SMTP:', compile, compose
a mail and take a look at the resulting email adresses
(right click).
}
{ +> Changes by Andreas Hoerig [mailto:andreas.hoerig@sillner.com] }
PRecip^.lpszAddress := StrNew(PChar('SMTP:' + FTOAdr.Strings[i - 1]));
{ +< Changes }
PRecip^.ulEIDSize := 0;
PRecip^.lpEntryID := nil;
Inc(PRecip);
end;
{ Same with the carbon copy recipients: (CC, MAPI_CC) }
for i := 1 to FCCAdr.Count do
begin
PRecip^.ulReserved := 0;
PRecip^.ulRecipClass := MAPI_CC;
PRecip^.lpszName := PChar(FCCAdr.Strings[i - 1]);
{ +> Changes by Andreas Hoerig [mailto:andreas.hoerig@sillner.com] }
PRecip^.lpszAddress := StrNew(PChar('SMTP:' + FCCAdr.Strings[i - 1]));
{ +< Changes }
PRecip^.ulEIDSize := 0;
PRecip^.lpEntryID := nil;
Inc(PRecip);
end;
{ ... and the blind copy recipients: (BCC, MAPI_BCC) }
for i := 1 to FBCCAdr.Count do
begin
PRecip^.ulReserved := 0;
PRecip^.ulRecipClass := MAPI_BCC;
PRecip^.lpszName := PChar(FBCCAdr.Strings[i - 1]);
{ +> Changes by Andreas Hoerig [mailto:andreas.hoerig@sillner.com] }
PRecip^.lpszAddress := StrNew(PChar('SMTP:' + FBCCAdr.Strings[i - 1]));
{ +< Changes }
PRecip^.ulEIDSize := 0;
PRecip^.lpEntryID := nil;
Inc(PRecip);
end;
end;
lpRecips := Recipients;
{ Now we process the attachments: }
nFileCount := FAttachedFileName.Count;
if nFileCount > 0 then
begin
GetMem(Attachments, nFileCount * sizeof(TMapiFileDesc));
PFiles := Attachments;
{ Fist setting up the display names (without path): }
FDisplayFileName.Clear;
for i := 1 to FAttachedFileName.Count do
FDisplayFileName.Add(ExtractFileName(FAttachedFileName[i - 1]));
if nFileCount > 0 then
begin
{ Now we pass the attached file (their paths) to the
structure: }
for i := 1 to FAttachedFileName.Count do
begin
{ Setting the complete Path }
Attachments^.lpszPathName := PChar(FAttachedFileName.Strings[i - 1]);
{ ... and the displayname: }
Attachments^.lpszFileName := PChar(FDisplayFileName.Strings[i - 1]);
Attachments^.ulReserved := 0;
Attachments^.flFlags := 0;
{ Position has to be -1, please see the WinApi Help
for details. }
Attachments^.nPosition := Cardinal(-1);
Attachments^.lpFileType := nil;
Inc(Attachments);
end;
end;
lpFiles := PFiles;
end
else
begin
nFileCount := 0;
lpFiles := nil;
end;
end;
{ Send the Mail, silent or verbose:
Verbose means in Express a Mail is composed and shown as setup.
In non-Express versions we show the Login-Dialog for a new
session and after we have choosen the profile to use, the
composed email is shown before sending
Silent does currently not work for non-Express version. We have
no Session, no Login Dialog so the system refuses to compose a
new email. In Express Versions the email is sent in the
background.
Please Note: It seems that your success on the delivery depends
on a combination of MAPI-Flags (MAPI_DIALOG, MAPI_LOGON_UI, ...)
and your used OS and Office Version. I am currently using
Win2K SP1 and Office 2K SP2 with no problems at all.
If you experience problems on another versions, please try
a different combination of flags for each purpose (Dialog or not).
I would be glad to setup a table with working flags on
each OS/Office combination, just drop me a line.
Possible combinations are also (with Dialog):
1. MAPI_DIALOG or MAPI_LOGON_UI MAPI_NEW_SESSION or MAPI_USE_DEFAULT
2. MAPI_SIMPLE_DEFAULT
See MAPI.PAS or MAPI.H (SDK) for more...
}
if FShowDialog then
MError := MapiSendMail(0, AppHandle, MapiMessage, MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0)
else
MError := MapiSendMail(0, AppHandle, MapiMessage, 0, 0);
{ Now we have to process the error messages. There are some
defined in the MAPI unit please take a look at the unit to get
familiar with it.
I decided to handle USER_ABORT and SUCCESS as special and leave
the rest to fire the "new" error event defined at the top (as
generic error)
Not treated as special (constants from mapi.pas):
MAPI_E_FAILURE = 2;
MAPI_E_LOGON_FAILURE = 3;
MAPI_E_LOGIN_FAILURE = MAPI_E_LOGON_FAILURE;
MAPI_E_DISK_FULL = 4;
MAPI_E_INSUFFICIENT_MEMORY = 5;
MAPI_E_ACCESS_DENIED = 6;
MAPI_E_TOO_MANY_SESSIONS = 8;
MAPI_E_TOO_MANY_FILES = 9;
MAPI_E_TOO_MANY_RECIPIENTS = 10;
MAPI_E_ATTACHMENT_NOT_FOUND = 11;
MAPI_E_ATTACHMENT_OPEN_FAILURE = 12;
MAPI_E_ATTACHMENT_WRITE_FAILURE = 13;
MAPI_E_UNKNOWN_RECIPIENT = 14;
MAPI_E_BAD_RECIPTYPE = 15;
MAPI_E_NO_MESSAGES = 16;
MAPI_E_INVALID_MESSAGE = 17;
MAPI_E_TEXT_TOO_LARGE = 18;
MAPI_E_INVALID_SESSION = 19;
MAPI_E_TYPE_NOT_SUPPORTED = 20;
MAPI_E_AMBIGUOUS_RECIPIENT = 21;
MAPI_E_AMBIG_RECIP = MAPI_E_AMBIGUOUS_RECIPIENT;
MAPI_E_MESSAGE_IN_USE = 22;
MAPI_E_NETWORK_FAILURE = 23;
MAPI_E_INVALID_EDITFIELDS = 24;
MAPI_E_INVALID_RECIPS = 25;
MAPI_E_NOT_SUPPORTED = 26;
}
{ case MError of
MAPI_E_USER_ABORT:
begin
if Assigned(FOnUserAbort) then
FOnUserAbort(Self);
end;
SUCCESS_SUCCESS:
begin
if Assigned(FOnSuccess) then
FOnSuccess(Self);
end
else
begin
if Assigned(FOnMapiError) then
FOnMapiError(Self, MError);
end;
end;}
Result := (MError = 0);
finally
{ Finally we do the cleanups, the message should be on its way }
{ +> Changes by Andreas Hoerig [mailto:andreas.hoerig@sillner.com] }
PRecip := Recipients;
for i := 1 to MapiMessage.nRecipCount do
begin
StrDispose(PRecip^.lpszAddress);
Inc(PRecip)
end;
{ +< Changes }
FreeMem(Recipients, MapiMessage.nRecipCount * sizeof(TMapiRecipDesc));
{ +> Changes due to Ken Halliwell [mailto:kjhalliwell@aol.com] }
if Assigned(PFiles) then
FreeMem(PFiles, MapiMessage.nFileCount * sizeof(TMapiFileDesc));
{ +< Changes }
end;
end;
end.

32
Source/Base/Utiles/uIntegerListUtils.pas
View File

@ -3,7 +3,7 @@ unit uIntegerListUtils;
interface
uses
Classes;
Classes, FactuGES_Intf;
type
TIntegerList = class(TList)
@ -14,10 +14,15 @@ type
procedure Add(Value: integer); reintroduce;
function Find(Value: integer; var Index: Integer): Boolean;
property Integers[index: integer]: integer read GetInteger write SetInteger; default;
function ToIntegerArray : TIntegerArray;
function ToString : String;
end;
implementation
uses
SysUtils;
function TIntegerList.GetInteger(Index: integer): integer;
begin
result := Integer(Items[index]);
@ -28,6 +33,30 @@ begin
Items[index] := Pointer(Value);
end;
function TIntegerList.ToIntegerArray: TIntegerArray;
var
i : Integer;
begin
Result := TIntegerArray.Create;
for i := 0 to Count - 1 do
Result.Add(Integers[i]);
end;
function TIntegerList.ToString: String;
var
i : Integer;
AList : TStringList;
begin
AList := TStringList.Create;
try
for i := 0 to Count - 1 do
AList.Add(IntToStr(Integers[i]));
Result := AList.CommaText;
finally
FreeANDNIL(AList);
end;
end;
procedure TIntegerList.Add(Value: integer);
var
Index: integer;
@ -59,3 +88,4 @@ begin
end;
end.

241
Source/Base/Utiles/uSistemaFunc.pas
View File

@ -20,33 +20,69 @@
---------------------------------------------------------------------------
===============================================================================
}
unit uSistemaFunc;
interface
uses SysUtils, Classes;
{ Funciones del sistema }
function Ejecutar (const LineaComando: String; Oculto, Esperar: Boolean) : Boolean;
procedure EscribirEnFichero (NombreFichero, Texto : string);
function DarRutaTemporal : String;
function DarDirectorioTemporal : String;
function DarFicheroTemporal : String;
function DarFicheroJPGTemporal : String;
function DarFicheroBMPTemporal : String;
function DarFicheroTIFFTemporal : String;
function DarFicheroExportar (var Fichero : String) : Boolean;
function DarFicheroHTMLTemporal : String;
function DarFicheroExcelTemporal : String;
function DarFicheroPDFTemporal : String; overload;
function DarFicheroPDFTemporal(const AFileName : String) : String; overload;
function DarVersionFichero (Executable : String) : String;
function DarFechaFichero (Executable : String) : String;
procedure CopiarFichero(const Origen, Destino: string);
procedure DoDelTree( TheDir : String);
procedure Deltree(DirToKill : String; KillChoosenDir : Boolean);
function GetSpecialFolderPath(folder : integer) : string;
function PreguntarRuta(const ATitulo: String; const AComentario: String; var ARuta: String): Boolean;
function PreguntarFicheroWordExportar (var Fichero : String) : Boolean;
function PreguntarFicheroExcelExportar (var Fichero : String) : Boolean;
function EscapeIllegalChars(AFileName: string): string;
function FindFile(const filespec: TFileName; attributes: integer = faReadOnly Or faHidden Or faSysFile Or faArchive): TStringList;
implementation
uses
SysUtils, Windows, Dialogs,
Windows, Dialogs, JclFileUtils,
Messages, Graphics, Controls, Forms,
StdCtrls, SHFolder, cxShellBrowserDialog,
cxLookAndFeels, uStringsUtils;
function GetSpecialFolderPath(folder : integer) : string;
const
SHGFP_TYPE_CURRENT = 0;
var
path: array [0..MAX_PATH] of char;
begin
if SUCCEEDED(SHGetFolderPath(0, folder, 0, SHGFP_TYPE_CURRENT, @path[0])) then
Result := path
else
Result := '';
end;
procedure EscribirEnFichero (NombreFichero, Texto : string);
var
FicheroAux : TextFile;
begin
SysUtils.DeleteFile(NombreFichero);
AssignFile(FicheroAux, NombreFichero);
Rewrite(FicheroAux);
WriteLn(FicheroAux, Texto);
CloseFile(FicheroAux);
end;
Messages, Classes, Graphics, Controls, Forms,
StdCtrls;
function Ejecutar (const LineaComando: String; Oculto, Esperar: Boolean): Boolean;
var
@ -112,6 +148,30 @@ begin
Result := Copy(Cadena, 0, (Length(Cadena)-3)) + 'tif';
end;
function DarFicheroPDFTemporal : String;
var
Cadena : String;
begin
Cadena := DarFicheroTemporal;
Result := Copy(Cadena, 0, (Length(Cadena)-3)) + 'pdf';
end;
function DarFicheroPDFTemporal(const AFileName : String) : String;
var
Cadena : String;
RutaTmp : string;
begin
if not EsCadenaVacia(AFileName) then
begin
RutaTmp := DarRutaTemporal;
Cadena := ExtractFileName(AFileName);
Cadena := StringReplace(Cadena, ExtractFileExt(Cadena), '', []);
Result := RutaTmp + Cadena + '.pdf';
end
else
Result := DarFicheroPDFTemporal;
end;
function DarFicheroBMPTemporal : String;
var
Cadena : String;
@ -120,6 +180,22 @@ begin
Result := Copy(Cadena, 0, (Length(Cadena)-3)) + 'bmp';
end;
function DarFicheroExcelTemporal : String;
var
Cadena : String;
begin
Cadena := DarFicheroTemporal;
Result := Copy(Cadena, 0, (Length(Cadena)-3)) + 'xls';
end;
function DarFicheroHTMLTemporal : String;
var
Cadena : String;
begin
Cadena := DarFicheroTemporal;
Result := Copy(Cadena, 0, (Length(Cadena)-3)) + 'html';
end;
function DarFicheroJPGTemporal : String;
var
Cadena : String;
@ -128,7 +204,7 @@ begin
Result := Copy(Cadena, 0, (Length(Cadena)-3)) + 'jpg';
end;
function DarFicheroExportar (var Fichero : String) : Boolean;
function PreguntarFicheroWordExportar (var Fichero : String) : Boolean;
var
DialogoSalvar : TSaveDialog;
begin
@ -149,29 +225,38 @@ begin
end;
end;
function PreguntarFicheroExcelExportar (var Fichero : String) : Boolean;
var
DialogoSalvar : TSaveDialog;
begin
DialogoSalvar := TSaveDialog.Create(NIL);
try
with DialogoSalvar do
begin
DefaultExt := 'xls';
Filter := 'Documento de Excel (*.xls)|*.xls';
FilterIndex := 0;
Options := [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofEnableSizing];
end;
Result := DialogoSalvar.Execute;
if Result then
Fichero := DialogoSalvar.FileName;
finally
DialogoSalvar.Free;
end;
end;
function DarVersionFichero (Executable : String) : String;
var
Size, Size2: DWord;
Pt, Pt2: Pointer;
Obj : TJclFileVersionInfo;
begin
Size := GetFileVersionInfoSize(PChar (Executable), Size2);
if Size > 0 then
begin
GetMem (Pt, Size);
try
GetFileVersionInfo (PChar (Executable), 0, Size, Pt);
VerQueryValue (Pt, '\', Pt2, Size2);
with TVSFixedFileInfo (Pt2^) do
begin
Result:= IntToStr (HiWord (dwFileVersionMS)) + '.' +
IntToStr (LoWord (dwFileVersionMS)) + '.' +
IntToStr (HiWord (dwFileVersionLS)) + '.' +
IntToStr (LoWord (dwFileVersionLS));
end;
finally
FreeMem (Pt);
end;
end;
Obj := TJclFileVersionInfo.Create(Application.ExeName);
try
Result := Obj.FileVersion;
finally
FreeAndNil(Obj);
end;
end;
function DarFechaFichero (Executable : String) : String;
@ -251,5 +336,105 @@ begin
end;
function PreguntarRuta(const ATitulo: String; const AComentario: String; var ARuta: String): Boolean;
var
cxShellBrowserDialog1: TcxShellBrowserDialog;
begin
cxShellBrowserDialog1 := TcxShellBrowserDialog.Create(NIL);
try
with cxShellBrowserDialog1 do
begin
Name := 'cxShellBrowserDialog1';
FolderLabelCaption := AComentario;
LookAndFeel.NativeStyle := True;
LookAndFeel.Kind := lfStandard;
Title := ATitulo;
Result := cxShellBrowserDialog1.Execute;
ARuta := cxShellBrowserDialog1.Path;
end;
finally
FreeANDNIL(cxShellBrowserDialog1);
end;
end;
function EscapeIllegalChars(AFileName: string): string;
var
x: integer;
const
IllegalCharSet: set of char =
['|','<','>','\','^','+','=','?','/','[',']','"',';',',','*'];
begin
for x := 1 to Length(AFileName) do
if AFileName[x] in IllegalCharSet then
AFileName[x] := '_';
Result := AFileName;
end;
function FindFile(const filespec: TFileName; attributes: integer): TStringList;
var
spec: string;
list: TStringList;
procedure RFindFile(const folder: TFileName);
var
SearchRec: TSearchRec;
begin
// Locate all matching files in the current
// folder and add their names to the list
if FindFirst(folder + spec, attributes, SearchRec) = 0 then begin
try
repeat
if (SearchRec.Attr and faDirectory = 0) or
(SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
list.Add(folder + SearchRec.Name);
until FindNext(SearchRec) <> 0;
except
SysUtils.FindClose(SearchRec);
raise;
end;
SysUtils.FindClose(SearchRec);
end;
// Now search the subfolders
if FindFirst(folder + '*', attributes
Or faDirectory, SearchRec) = 0 then
begin
try
repeat
if ((SearchRec.Attr and faDirectory) <> 0) and
(SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
RFindFile(folder + SearchRec.Name + '\');
until FindNext(SearchRec) <> 0;
except
SysUtils.FindClose(SearchRec);
raise;
end;
SysUtils.FindClose(SearchRec);
end;
end; // procedure RFindFile inside of FindFile
begin // function FindFile
list := TStringList.Create;
try
spec := ExtractFileName(filespec);
RFindFile(ExtractFilePath(filespec));
Result := list;
except
list.Free;
raise;
end;
end;
function DarDirectorioTemporal : String;
var
Cadena: String;
begin
Cadena := ExtractFileName(DarFicheroTemporal);
Cadena := StringReplace(Cadena, ExtractFileExt(Cadena), '', []);
Result := DarRutaTemporal + Cadena + '\';
end;
end.

BIN
Source/Iconos/Generales/16x16/Mail.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 592 B

BIN
Source/Iconos/Generales/16x16/header_email.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.1 KiB

BIN
Source/Iconos/Generales/16x16/header_printer.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.2 KiB

BIN
Source/Iconos/Generales/24x24/Mail.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 775 B

BIN
Source/Iconos/Generales/28x28/Mail.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 976 B

21
Source/Modulos/Contactos/Data/uDataModuleClientes.dfm
View File

@ -25,9 +25,6 @@ inherited DataModuleClientes: TDataModuleClientes
UserClassName = 'TRdxLoginInfo'
end>
end
inherited ROWinInetHTTPChannel1: TROWinInetHTTPChannel
TargetURL = 'http://localhost:8090/bin'
end
object tbl_Clientes: TDACDSDataTable
RemoteUpdatesOptions = []
Fields = <
@ -478,8 +475,9 @@ inherited DataModuleClientes: TDataModuleClientes
Size = 255
BlobType = dabtUnknown
DisplayWidth = 0
DisplayLabel = 'Agente'
DisplayLabel = 'Clientes_AGENTE'
Alignment = taLeftJustify
DictionaryEntry = 'Clientes_AGENTE'
InPrimaryKey = False
Calculated = False
Lookup = False
@ -492,6 +490,21 @@ inherited DataModuleClientes: TDataModuleClientes
DisplayWidth = 0
DisplayLabel = 'Rapel'
Alignment = taLeftJustify
DictionaryEntry = 'Clientes_RAPEL'
InPrimaryKey = False
Calculated = False
Lookup = False
LookupCache = False
end
item
Name = 'EMAIL_ADMINISTRACION'
DataType = datString
Size = 255
BlobType = dabtUnknown
DisplayWidth = 0
DisplayLabel = 'E-mail administrativo'
Alignment = taLeftJustify
DictionaryEntry = 'Clientes_EMAIL_ADMINISTRACION'
InPrimaryKey = False
Calculated = False
Lookup = False

25
Source/Modulos/Contactos/Data/uDataModuleProveedores.dfm
View File

@ -1,4 +1,6 @@
inherited DataModuleProveedores: TDataModuleProveedores
Height = 412
Width = 516
object tbl_Proveedores: TDACDSDataTable
RemoteUpdatesOptions = []
Fields = <
@ -358,6 +360,21 @@ inherited DataModuleProveedores: TDataModuleProveedores
BlobType = dabtUnknown
DisplayWidth = 0
Alignment = taLeftJustify
DictionaryEntry = 'Proveedores_TIENDA_WEB'
InPrimaryKey = False
Calculated = False
Lookup = False
LookupCache = False
end
item
Name = 'EMAIL_ADMINISTRACION'
DataType = datString
Size = 255
BlobType = dabtUnknown
DisplayWidth = 0
DisplayLabel = 'E-mail administrativo'
Alignment = taLeftJustify
DictionaryEntry = 'Proveedores_EMAIL_ADMINISTRACION'
InPrimaryKey = False
Calculated = False
Lookup = False
@ -449,12 +466,12 @@ inherited DataModuleProveedores: TDataModuleProveedores
MasterOptions = [moCascadeOpenClose, moCascadeApplyUpdates, moCascadeDelete, moCascadeUpdate, moDisableLogOfCascadeDeletes, moDisableLogOfCascadeUpdates]
LogicalName = 'Proveedores'
IndexDefs = <>
Left = 296
Top = 184
Left = 288
Top = 160
end
object ds_Proveedores: TDADataSource
DataTable = tbl_Proveedores
Left = 296
Top = 256
Left = 288
Top = 224
end
end

2
Source/Modulos/Contactos/Model/Contactos_model.bdsproj
View File

@ -176,7 +176,7 @@
<Excluded_Packages Name="D:\MISDOC~1\BORLAN~1\Bpl\JclFavoriteFoldersExpert100.bpl">JCL Open and Save IDE dialogs with favorite folders</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<!-- EurekaLog First Line
<!-- EurekaLog First Line
[Exception Log]
EurekaLog Version=519
Activate=1

4
Source/Modulos/Contactos/Model/Contactos_model.dpk
View File

@ -57,8 +57,8 @@ contains
uBizClientesDescuentos in 'uBizClientesDescuentos.pas',
uRegimenIVAUtils in '..\Utiles\uRegimenIVAUtils.pas',
uBizGruposCliente in 'uBizGruposCliente.pas',
uIDataModuleEtiquetasContactosReport in 'Data\uIDataModuleEtiquetasContactosReport.pas',
schContactosClient_Intf in 'schContactosClient_Intf.pas',
schContactosServer_Intf in 'schContactosServer_Intf.pas',
uIDataModuleEtiquetasContactosReport in 'Data\uIDataModuleEtiquetasContactosReport.pas';
schContactosServer_Intf in 'schContactosServer_Intf.pas';
end.

80
Source/Modulos/Contactos/Model/schContactosClient_Intf.pas
View File

@ -9,17 +9,17 @@ const
{ Data table rules ids
Feel free to change them to something more human readable
but make sure they are unique in the context of your application }
RID_Contactos = '{C260E044-1DBE-4317-8EE3-E26C54B06882}';
RID_GruposCliente = '{485DBE9F-8AA7-4F62-9835-039A5760D7B6}';
RID_ClienteEliminable = '{72AA6F84-2D78-41E9-BD93-8C16E821FE97}';
RID_DatosBancarios = '{AD44FAAE-1EE0-4F55-B813-AFCAF2973610}';
RID_ContactosCategorias = '{A4B8E515-5AB8-42F0-99D6-8588562AD9E6}';
RID_Clientes = '{712C57EB-6A72-461B-A1F1-1B7A369F05AF}';
RID_Proveedores = '{95FDA94D-4F5C-41F5-BEC1-5847F09E8884}';
RID_Agentes = '{C7F2E42A-0F55-49AB-A8DE-D91125998892}';
RID_DireccionesContacto = '{1D4A76E0-FF67-473B-975B-E8B8017074C6}';
RID_AgentesComisiones = '{ACB3D70D-B0D0-461D-B693-A03105F07A04}';
RID_ClientesDescuentos = '{9497F44D-476F-49AE-9F07-9FB49A0FDFEF}';
RID_Contactos = '{B7DC3FCE-26AF-4E39-8683-E8D9B1BF7590}';
RID_GruposCliente = '{EF2E0CAE-A8B0-49A1-B8CF-B8C49D32AEFD}';
RID_ClienteEliminable = '{24F89D65-8CA6-43F7-83FE-89A982EA5B2B}';
RID_DatosBancarios = '{C36E8DE7-35F2-44CD-BB72-F87F1EFA8E6A}';
RID_ContactosCategorias = '{C49DC4A7-3D9B-4AF8-88A7-A0E2E65DA885}';
RID_Clientes = '{3F54A7C9-EC37-440B-AE22-5C200C988E72}';
RID_Proveedores = '{04909F44-00A2-4046-BC0F-78DD9F66AADF}';
RID_Agentes = '{1BC26A94-145F-4765-BC9C-483274E85F96}';
RID_DireccionesContacto = '{C738093E-2D7D-4F23-8EE3-0829E7FC6D0B}';
RID_AgentesComisiones = '{F5ADDFE9-5BBA-4D64-B261-C4F96707D016}';
RID_ClientesDescuentos = '{E946CA4B-0340-4324-8B21-B8D258509F86}';
{ Data table names }
nme_Contactos = 'Contactos';
@ -158,6 +158,7 @@ const
fld_ClientesTIENDA_WEB = 'TIENDA_WEB';
fld_ClientesAGENTE = 'AGENTE';
fld_ClientesRAPEL = 'RAPEL';
fld_ClientesEMAIL_ADMINISTRACION = 'EMAIL_ADMINISTRACION';
{ Clientes field indexes }
idx_ClientesID = 0;
@ -195,6 +196,7 @@ const
idx_ClientesTIENDA_WEB = 32;
idx_ClientesAGENTE = 33;
idx_ClientesRAPEL = 34;
idx_ClientesEMAIL_ADMINISTRACION = 35;
{ Proveedores fields }
fld_ProveedoresID = 'ID';
@ -224,6 +226,7 @@ const
fld_ProveedoresID_TIPO_IVA = 'ID_TIPO_IVA';
fld_ProveedoresID_FORMA_PAGO = 'ID_FORMA_PAGO';
fld_ProveedoresTIENDA_WEB = 'TIENDA_WEB';
fld_ProveedoresEMAIL_ADMINISTRACION = 'EMAIL_ADMINISTRACION';
{ Proveedores field indexes }
idx_ProveedoresID = 0;
@ -253,6 +256,7 @@ const
idx_ProveedoresID_TIPO_IVA = 24;
idx_ProveedoresID_FORMA_PAGO = 25;
idx_ProveedoresTIENDA_WEB = 26;
idx_ProveedoresEMAIL_ADMINISTRACION = 27;
{ Agentes fields }
fld_AgentesID = 'ID';
@ -365,7 +369,7 @@ const
type
{ IContactos }
IContactos = interface(IDAStronglyTypedDataTable)
['{F43F5539-504E-40F0-AB6E-28AE9E8BED0F}']
['{3C467D50-383F-4253-82A6-6D6BFBAB736C}']
{ Property getters and setters }
function GetIDValue: Integer;
procedure SetIDValue(const aValue: Integer);
@ -520,7 +524,7 @@ type
{ IGruposCliente }
IGruposCliente = interface(IDAStronglyTypedDataTable)
['{A26044F4-A906-4449-9B0E-9DC17E10D776}']
['{E9FE8307-940C-4908-9B25-951994F738CF}']
{ Property getters and setters }
function GetDESCRIPCIONValue: String;
procedure SetDESCRIPCIONValue(const aValue: String);
@ -549,7 +553,7 @@ type
{ IClienteEliminable }
IClienteEliminable = interface(IDAStronglyTypedDataTable)
['{A49EAEA5-DD44-4073-BA1F-FD2CC0F51589}']
['{6C7EAFC6-7134-4304-B79F-2EDEE270F265}']
{ Property getters and setters }
function GetIDValue: Integer;
procedure SetIDValue(const aValue: Integer);
@ -584,7 +588,7 @@ type
{ IDatosBancarios }
IDatosBancarios = interface(IDAStronglyTypedDataTable)
['{8078722E-769A-4D5C-8D47-EDB97CCAC1D3}']
['{CEEE0955-68DD-48C2-AEFC-693FC07AC72A}']
{ Property getters and setters }
function GetIDValue: Integer;
procedure SetIDValue(const aValue: Integer);
@ -649,7 +653,7 @@ type
{ IContactosCategorias }
IContactosCategorias = interface(IDAStronglyTypedDataTable)
['{0B218ADA-3D3C-48C9-A759-ECC32D05888F}']
['{050F8EDE-5439-425F-9A11-5053D25BC1B5}']
{ Property getters and setters }
function GetID_CONTACTOValue: Integer;
procedure SetID_CONTACTOValue(const aValue: Integer);
@ -684,7 +688,7 @@ type
{ IClientes }
IClientes = interface(IDAStronglyTypedDataTable)
['{D98FD711-23A0-4EF4-90DA-BD0E8BB0EA73}']
['{BC299125-C6CC-4AF6-8FAA-1F77ABFF8795}']
{ Property getters and setters }
function GetIDValue: Integer;
procedure SetIDValue(const aValue: Integer);
@ -756,6 +760,8 @@ type
procedure SetAGENTEValue(const aValue: String);
function GetRAPELValue: Integer;
procedure SetRAPELValue(const aValue: Integer);
function GetEMAIL_ADMINISTRACIONValue: String;
procedure SetEMAIL_ADMINISTRACIONValue(const aValue: String);
{ Properties }
@ -794,6 +800,7 @@ type
property TIENDA_WEB: Integer read GetTIENDA_WEBValue write SetTIENDA_WEBValue;
property AGENTE: String read GetAGENTEValue write SetAGENTEValue;
property RAPEL: Integer read GetRAPELValue write SetRAPELValue;
property EMAIL_ADMINISTRACION: String read GetEMAIL_ADMINISTRACIONValue write SetEMAIL_ADMINISTRACIONValue;
end;
{ TClientesDataTableRules }
@ -871,6 +878,8 @@ type
procedure SetAGENTEValue(const aValue: String); virtual;
function GetRAPELValue: Integer; virtual;
procedure SetRAPELValue(const aValue: Integer); virtual;
function GetEMAIL_ADMINISTRACIONValue: String; virtual;
procedure SetEMAIL_ADMINISTRACIONValue(const aValue: String); virtual;
{ Properties }
property ID: Integer read GetIDValue write SetIDValue;
@ -908,6 +917,7 @@ type
property TIENDA_WEB: Integer read GetTIENDA_WEBValue write SetTIENDA_WEBValue;
property AGENTE: String read GetAGENTEValue write SetAGENTEValue;
property RAPEL: Integer read GetRAPELValue write SetRAPELValue;
property EMAIL_ADMINISTRACION: String read GetEMAIL_ADMINISTRACIONValue write SetEMAIL_ADMINISTRACIONValue;
public
constructor Create(aDataTable: TDADataTable); override;
@ -917,7 +927,7 @@ type
{ IProveedores }
IProveedores = interface(IDAStronglyTypedDataTable)
['{8FD793F9-7D25-4778-9F79-5C37BC75FC4B}']
['{D032B1BB-4428-4D4B-ADFF-18C40DFF04E5}']
{ Property getters and setters }
function GetIDValue: Integer;
procedure SetIDValue(const aValue: Integer);
@ -973,6 +983,8 @@ type
procedure SetID_FORMA_PAGOValue(const aValue: Integer);
function GetTIENDA_WEBValue: Integer;
procedure SetTIENDA_WEBValue(const aValue: Integer);
function GetEMAIL_ADMINISTRACIONValue: String;
procedure SetEMAIL_ADMINISTRACIONValue(const aValue: String);
{ Properties }
@ -1003,6 +1015,7 @@ type
property ID_TIPO_IVA: Integer read GetID_TIPO_IVAValue write SetID_TIPO_IVAValue;
property ID_FORMA_PAGO: Integer read GetID_FORMA_PAGOValue write SetID_FORMA_PAGOValue;
property TIENDA_WEB: Integer read GetTIENDA_WEBValue write SetTIENDA_WEBValue;
property EMAIL_ADMINISTRACION: String read GetEMAIL_ADMINISTRACIONValue write SetEMAIL_ADMINISTRACIONValue;
end;
{ TProveedoresDataTableRules }
@ -1064,6 +1077,8 @@ type
procedure SetID_FORMA_PAGOValue(const aValue: Integer); virtual;
function GetTIENDA_WEBValue: Integer; virtual;
procedure SetTIENDA_WEBValue(const aValue: Integer); virtual;
function GetEMAIL_ADMINISTRACIONValue: String; virtual;
procedure SetEMAIL_ADMINISTRACIONValue(const aValue: String); virtual;
{ Properties }
property ID: Integer read GetIDValue write SetIDValue;
@ -1093,6 +1108,7 @@ type
property ID_TIPO_IVA: Integer read GetID_TIPO_IVAValue write SetID_TIPO_IVAValue;
property ID_FORMA_PAGO: Integer read GetID_FORMA_PAGOValue write SetID_FORMA_PAGOValue;
property TIENDA_WEB: Integer read GetTIENDA_WEBValue write SetTIENDA_WEBValue;
property EMAIL_ADMINISTRACION: String read GetEMAIL_ADMINISTRACIONValue write SetEMAIL_ADMINISTRACIONValue;
public
constructor Create(aDataTable: TDADataTable); override;
@ -1102,7 +1118,7 @@ type
{ IAgentes }
IAgentes = interface(IDAStronglyTypedDataTable)
['{357D8554-8311-4B0A-B4AA-5CA1A4CD70F6}']
['{4BD59D5A-FDD8-492D-BC9F-AD0BE9BF5C59}']
{ Property getters and setters }
function GetIDValue: Integer;
procedure SetIDValue(const aValue: Integer);
@ -1257,7 +1273,7 @@ type
{ IDireccionesContacto }
IDireccionesContacto = interface(IDAStronglyTypedDataTable)
['{996BD6F8-AC46-40E8-972D-CF490CA6502E}']
['{502FC7D0-9317-4FFF-8BA9-BA9EF2175658}']
{ Property getters and setters }
function GetIDValue: Integer;
procedure SetIDValue(const aValue: Integer);
@ -1364,7 +1380,7 @@ type
{ IAgentesComisiones }
IAgentesComisiones = interface(IDAStronglyTypedDataTable)
['{73F820E5-B1F7-4324-897D-C7F715120A6D}']
['{B5F34E66-A3FD-4F36-8AAA-095427E63248}']
{ Property getters and setters }
function GetIDValue: Integer;
procedure SetIDValue(const aValue: Integer);
@ -1417,7 +1433,7 @@ type
{ IClientesDescuentos }
IClientesDescuentos = interface(IDAStronglyTypedDataTable)
['{57542EBE-886B-4ED4-8AC5-4CE5866A7822}']
['{A5D040AA-3D38-4284-AF0F-171AE311BC17}']
{ Property getters and setters }
function GetIDValue: Integer;
procedure SetIDValue(const aValue: Integer);
@ -2235,6 +2251,16 @@ begin
DataTable.Fields[idx_ClientesRAPEL].AsInteger := aValue;
end;
function TClientesDataTableRules.GetEMAIL_ADMINISTRACIONValue: String;
begin
result := DataTable.Fields[idx_ClientesEMAIL_ADMINISTRACION].AsString;
end;
procedure TClientesDataTableRules.SetEMAIL_ADMINISTRACIONValue(const aValue: String);
begin
DataTable.Fields[idx_ClientesEMAIL_ADMINISTRACION].AsString := aValue;
end;
{ TProveedoresDataTableRules }
constructor TProveedoresDataTableRules.Create(aDataTable: TDADataTable);
@ -2518,6 +2544,16 @@ begin
DataTable.Fields[idx_ProveedoresTIENDA_WEB].AsInteger := aValue;
end;
function TProveedoresDataTableRules.GetEMAIL_ADMINISTRACIONValue: String;
begin
result := DataTable.Fields[idx_ProveedoresEMAIL_ADMINISTRACION].AsString;
end;
procedure TProveedoresDataTableRules.SetEMAIL_ADMINISTRACIONValue(const aValue: String);
begin
DataTable.Fields[idx_ProveedoresEMAIL_ADMINISTRACION].AsString := aValue;
end;
{ TAgentesDataTableRules }
constructor TAgentesDataTableRules.Create(aDataTable: TDADataTable);

88
Source/Modulos/Contactos/Model/schContactosServer_Intf.pas
View File

@ -9,22 +9,22 @@ const
{ Delta rules ids
Feel free to change them to something more human readable
but make sure they are unique in the context of your application }
RID_ContactosDelta = '{7E3297E2-946F-4D58-A2EF-7DE83AB09D46}';
RID_GruposClienteDelta = '{4395BB07-CBF9-4206-81A6-93D893B5E677}';
RID_ClienteEliminableDelta = '{7BA816F5-6EE6-496E-9065-F5E6FA896666}';
RID_DatosBancariosDelta = '{E2AC40C8-67A4-4C06-AD06-55768A2A7B3F}';
RID_ContactosCategoriasDelta = '{B723F25C-7D69-4F4B-983A-A9338FFE755A}';
RID_ClientesDelta = '{7DDCA305-634A-44EC-9A34-F1416E10EB47}';
RID_ProveedoresDelta = '{CC343ECA-6652-46C3-B09C-886E2586E396}';
RID_AgentesDelta = '{2AAA54EF-C728-49E1-BEE9-DBB089917E3E}';
RID_DireccionesContactoDelta = '{8D5DFF6B-F949-4DED-AE44-A1AD2AF6A8D0}';
RID_AgentesComisionesDelta = '{4CBC6CEE-82AF-49BD-926E-D377B4A7D720}';
RID_ClientesDescuentosDelta = '{90066378-38B8-4019-A755-A48C6FF62113}';
RID_ContactosDelta = '{A7B6097C-289E-4DA1-8A61-B3DC49200E30}';
RID_GruposClienteDelta = '{DA9A3D00-E518-404D-AA5C-E4FD7A3D6E9E}';
RID_ClienteEliminableDelta = '{2E8C71F3-A03B-4DEF-B2CC-AC7A21FCAC06}';
RID_DatosBancariosDelta = '{EDE6858F-F636-4695-9986-EA35E3AF623D}';
RID_ContactosCategoriasDelta = '{61DE38E4-28AD-4265-8987-B6C62DACCAFA}';
RID_ClientesDelta = '{35EC6E73-DE47-4999-9510-71195EC6D430}';
RID_ProveedoresDelta = '{9676090D-3DE0-4D67-A393-6FF60C8E5B49}';
RID_AgentesDelta = '{7EDE4E87-585C-4CAB-B7F3-163BCE50061E}';
RID_DireccionesContactoDelta = '{67F829A3-66F5-4D97-883C-8BBFD5706093}';
RID_AgentesComisionesDelta = '{51F716E5-C971-4A54-B547-A01705D741CA}';
RID_ClientesDescuentosDelta = '{1C199959-D746-4DAB-AC83-A573D14C9E15}';
type
{ IContactosDelta }
IContactosDelta = interface(IContactos)
['{7E3297E2-946F-4D58-A2EF-7DE83AB09D46}']
['{A7B6097C-289E-4DA1-8A61-B3DC49200E30}']
{ Property getters and setters }
function GetOldIDValue : Integer;
function GetOldID_CATEGORIAValue : Integer;
@ -200,7 +200,7 @@ type
{ IGruposClienteDelta }
IGruposClienteDelta = interface(IGruposCliente)
['{4395BB07-CBF9-4206-81A6-93D893B5E677}']
['{DA9A3D00-E518-404D-AA5C-E4FD7A3D6E9E}']
{ Property getters and setters }
function GetOldDESCRIPCIONValue : String;
@ -229,7 +229,7 @@ type
{ IClienteEliminableDelta }
IClienteEliminableDelta = interface(IClienteEliminable)
['{7BA816F5-6EE6-496E-9065-F5E6FA896666}']
['{2E8C71F3-A03B-4DEF-B2CC-AC7A21FCAC06}']
{ Property getters and setters }
function GetOldIDValue : Integer;
function GetOldNOMBREValue : String;
@ -265,7 +265,7 @@ type
{ IDatosBancariosDelta }
IDatosBancariosDelta = interface(IDatosBancarios)
['{E2AC40C8-67A4-4C06-AD06-55768A2A7B3F}']
['{EDE6858F-F636-4695-9986-EA35E3AF623D}']
{ Property getters and setters }
function GetOldIDValue : Integer;
function GetOldID_CONTACTOValue : Integer;
@ -336,7 +336,7 @@ type
{ IContactosCategoriasDelta }
IContactosCategoriasDelta = interface(IContactosCategorias)
['{B723F25C-7D69-4F4B-983A-A9338FFE755A}']
['{61DE38E4-28AD-4265-8987-B6C62DACCAFA}']
{ Property getters and setters }
function GetOldID_CONTACTOValue : Integer;
function GetOldID_CATEGORIAValue : Integer;
@ -372,7 +372,7 @@ type
{ IClientesDelta }
IClientesDelta = interface(IClientes)
['{7DDCA305-634A-44EC-9A34-F1416E10EB47}']
['{35EC6E73-DE47-4999-9510-71195EC6D430}']
{ Property getters and setters }
function GetOldIDValue : Integer;
function GetOldID_CATEGORIAValue : Integer;
@ -409,6 +409,7 @@ type
function GetOldTIENDA_WEBValue : Integer;
function GetOldAGENTEValue : String;
function GetOldRAPELValue : Integer;
function GetOldEMAIL_ADMINISTRACIONValue : String;
{ Properties }
property OldID : Integer read GetOldIDValue;
@ -446,6 +447,7 @@ type
property OldTIENDA_WEB : Integer read GetOldTIENDA_WEBValue;
property OldAGENTE : String read GetOldAGENTEValue;
property OldRAPEL : Integer read GetOldRAPELValue;
property OldEMAIL_ADMINISTRACION : String read GetOldEMAIL_ADMINISTRACIONValue;
end;
{ TClientesBusinessProcessorRules }
@ -558,6 +560,9 @@ type
function GetRAPELValue: Integer; virtual;
function GetOldRAPELValue: Integer; virtual;
procedure SetRAPELValue(const aValue: Integer); virtual;
function GetEMAIL_ADMINISTRACIONValue: String; virtual;
function GetOldEMAIL_ADMINISTRACIONValue: String; virtual;
procedure SetEMAIL_ADMINISTRACIONValue(const aValue: String); virtual;
{ Properties }
property ID : Integer read GetIDValue write SetIDValue;
@ -630,6 +635,8 @@ type
property OldAGENTE : String read GetOldAGENTEValue;
property RAPEL : Integer read GetRAPELValue write SetRAPELValue;
property OldRAPEL : Integer read GetOldRAPELValue;
property EMAIL_ADMINISTRACION : String read GetEMAIL_ADMINISTRACIONValue write SetEMAIL_ADMINISTRACIONValue;
property OldEMAIL_ADMINISTRACION : String read GetOldEMAIL_ADMINISTRACIONValue;
public
constructor Create(aBusinessProcessor: TDABusinessProcessor); override;
@ -639,7 +646,7 @@ type
{ IProveedoresDelta }
IProveedoresDelta = interface(IProveedores)
['{CC343ECA-6652-46C3-B09C-886E2586E396}']
['{9676090D-3DE0-4D67-A393-6FF60C8E5B49}']
{ Property getters and setters }
function GetOldIDValue : Integer;
function GetOldID_CATEGORIAValue : Integer;
@ -668,6 +675,7 @@ type
function GetOldID_TIPO_IVAValue : Integer;
function GetOldID_FORMA_PAGOValue : Integer;
function GetOldTIENDA_WEBValue : Integer;
function GetOldEMAIL_ADMINISTRACIONValue : String;
{ Properties }
property OldID : Integer read GetOldIDValue;
@ -697,6 +705,7 @@ type
property OldID_TIPO_IVA : Integer read GetOldID_TIPO_IVAValue;
property OldID_FORMA_PAGO : Integer read GetOldID_FORMA_PAGOValue;
property OldTIENDA_WEB : Integer read GetOldTIENDA_WEBValue;
property OldEMAIL_ADMINISTRACION : String read GetOldEMAIL_ADMINISTRACIONValue;
end;
{ TProveedoresBusinessProcessorRules }
@ -785,6 +794,9 @@ type
function GetTIENDA_WEBValue: Integer; virtual;
function GetOldTIENDA_WEBValue: Integer; virtual;
procedure SetTIENDA_WEBValue(const aValue: Integer); virtual;
function GetEMAIL_ADMINISTRACIONValue: String; virtual;
function GetOldEMAIL_ADMINISTRACIONValue: String; virtual;
procedure SetEMAIL_ADMINISTRACIONValue(const aValue: String); virtual;
{ Properties }
property ID : Integer read GetIDValue write SetIDValue;
@ -841,6 +853,8 @@ type
property OldID_FORMA_PAGO : Integer read GetOldID_FORMA_PAGOValue;
property TIENDA_WEB : Integer read GetTIENDA_WEBValue write SetTIENDA_WEBValue;
property OldTIENDA_WEB : Integer read GetOldTIENDA_WEBValue;
property EMAIL_ADMINISTRACION : String read GetEMAIL_ADMINISTRACIONValue write SetEMAIL_ADMINISTRACIONValue;
property OldEMAIL_ADMINISTRACION : String read GetOldEMAIL_ADMINISTRACIONValue;
public
constructor Create(aBusinessProcessor: TDABusinessProcessor); override;
@ -850,7 +864,7 @@ type
{ IAgentesDelta }
IAgentesDelta = interface(IAgentes)
['{2AAA54EF-C728-49E1-BEE9-DBB089917E3E}']
['{7EDE4E87-585C-4CAB-B7F3-163BCE50061E}']
{ Property getters and setters }
function GetOldIDValue : Integer;
function GetOldID_CATEGORIAValue : Integer;
@ -1026,7 +1040,7 @@ type
{ IDireccionesContactoDelta }
IDireccionesContactoDelta = interface(IDireccionesContacto)
['{8D5DFF6B-F949-4DED-AE44-A1AD2AF6A8D0}']
['{67F829A3-66F5-4D97-883C-8BBFD5706093}']
{ Property getters and setters }
function GetOldIDValue : Integer;
function GetOldID_CONTACTOValue : Integer;
@ -1146,7 +1160,7 @@ type
{ IAgentesComisionesDelta }
IAgentesComisionesDelta = interface(IAgentesComisiones)
['{4CBC6CEE-82AF-49BD-926E-D377B4A7D720}']
['{51F716E5-C971-4A54-B547-A01705D741CA}']
{ Property getters and setters }
function GetOldIDValue : Integer;
function GetOldID_AGENTEValue : Integer;
@ -1203,7 +1217,7 @@ type
{ IClientesDescuentosDelta }
IClientesDescuentosDelta = interface(IClientesDescuentos)
['{90066378-38B8-4019-A755-A48C6FF62113}']
['{1C199959-D746-4DAB-AC83-A573D14C9E15}']
{ Property getters and setters }
function GetOldIDValue : Integer;
function GetOldID_CLIENTEValue : Integer;
@ -2373,6 +2387,21 @@ begin
BusinessProcessor.CurrentChange.NewValueByName[fld_ClientesRAPEL] := aValue;
end;
function TClientesBusinessProcessorRules.GetEMAIL_ADMINISTRACIONValue: String;
begin
result := BusinessProcessor.CurrentChange.NewValueByName[fld_ClientesEMAIL_ADMINISTRACION];
end;
function TClientesBusinessProcessorRules.GetOldEMAIL_ADMINISTRACIONValue: String;
begin
result := BusinessProcessor.CurrentChange.OldValueByName[fld_ClientesEMAIL_ADMINISTRACION];
end;
procedure TClientesBusinessProcessorRules.SetEMAIL_ADMINISTRACIONValue(const aValue: String);
begin
BusinessProcessor.CurrentChange.NewValueByName[fld_ClientesEMAIL_ADMINISTRACION] := aValue;
end;
{ TProveedoresBusinessProcessorRules }
constructor TProveedoresBusinessProcessorRules.Create(aBusinessProcessor: TDABusinessProcessor);
@ -2792,6 +2821,21 @@ begin
BusinessProcessor.CurrentChange.NewValueByName[fld_ProveedoresTIENDA_WEB] := aValue;
end;
function TProveedoresBusinessProcessorRules.GetEMAIL_ADMINISTRACIONValue: String;
begin
result := BusinessProcessor.CurrentChange.NewValueByName[fld_ProveedoresEMAIL_ADMINISTRACION];
end;
function TProveedoresBusinessProcessorRules.GetOldEMAIL_ADMINISTRACIONValue: String;
begin
result := BusinessProcessor.CurrentChange.OldValueByName[fld_ProveedoresEMAIL_ADMINISTRACION];
end;
procedure TProveedoresBusinessProcessorRules.SetEMAIL_ADMINISTRACIONValue(const aValue: String);
begin
BusinessProcessor.CurrentChange.NewValueByName[fld_ProveedoresEMAIL_ADMINISTRACION] := aValue;
end;
{ TAgentesBusinessProcessorRules }
constructor TAgentesBusinessProcessorRules.Create(aBusinessProcessor: TDABusinessProcessor);

2
Source/Modulos/Contactos/Model/uBizClientesServer.pas
View File

@ -76,6 +76,7 @@ begin
ParamByName('ID_FORMA_PAGO').Value := aChange.NewValueByName[fld_ClientesID_FORMA_PAGO];
ParamByName('TIENDA_WEB').Value := aChange.NewValueByName[fld_ClientesTIENDA_WEB];
ParamByName('RAPEL').Value := aChange.NewValueByName[fld_ClientesRAPEL];
ParamByName('EMAIL_ADMINISTRACION').Value := aChange.NewValueByName[fld_ClientesEMAIL_ADMINISTRACION];
Execute;
end;
finally
@ -113,6 +114,7 @@ begin
ParamByName('ID_FORMA_PAGO').Value := aChange.NewValueByName[fld_ClientesID_FORMA_PAGO];
ParamByName('TIENDA_WEB').Value := aChange.NewValueByName[fld_ClientesTIENDA_WEB];
ParamByName('RAPEL').Value := aChange.NewValueByName[fld_ClientesRAPEL];
ParamByName('EMAIL_ADMINISTRACION').Value := aChange.NewValueByName[fld_ClientesEMAIL_ADMINISTRACION];
Execute;
end;
finally

43
Source/Modulos/Contactos/Model/uBizContactos.pas
View File

@ -89,6 +89,9 @@ type
procedure SetDescuentos(Value: IBizClienteDescuentos);
property Descuentos: IBizClienteDescuentos read GetDescuentos write SetDescuentos;
function GetEMAIL_ADMINISTRACIONValue: String;
procedure SetEMAIL_ADMINISTRACIONValue(const aValue: String);
property ID_AGENTE: Integer read GetID_AGENTEValue write SetID_AGENTEValue;
property GRUPO_CLIENTE: String read GetGRUPO_CLIENTEValue write SetGRUPO_CLIENTEValue;
@ -101,7 +104,8 @@ type
property REGIMEN_IVA: String read GetREGIMEN_IVAValue write SetREGIMEN_IVAValue;
property ID_TIPO_IVA: Integer read GetID_TIPO_IVAValue write SetID_TIPO_IVAValue;
property ID_FORMA_PAGO: Integer read GetID_FORMA_PAGOValue write SetID_FORMA_PAGOValue;
property TIENDA_WEB: Integer read GetTIENDA_WEBValue write SetTIENDA_WEBValue;
property TIENDA_WEB: Integer read GetTIENDA_WEBValue write SetTIENDA_WEBValue;
property EMAIL_ADMINISTRACION: String read GetEMAIL_ADMINISTRACIONValue write SetEMAIL_ADMINISTRACIONValue;
end;
IBizProveedor = interface (IBizContacto)
@ -121,11 +125,15 @@ type
function GetTIENDA_WEBValue: Integer;
procedure SetTIENDA_WEBValue(const aValue: Integer);
function GetEMAIL_ADMINISTRACIONValue: String;
procedure SetEMAIL_ADMINISTRACIONValue(const aValue: String);
property REGIMEN_IVA: String read GetREGIMEN_IVAValue write SetREGIMEN_IVAValue;
property DESCUENTO: Float read GetDESCUENTOValue write SetDESCUENTOValue;
property ID_TIPO_IVA: Integer read GetID_TIPO_IVAValue write SetID_TIPO_IVAValue;
property ID_FORMA_PAGO: Integer read GetID_FORMA_PAGOValue write SetID_FORMA_PAGOValue;
property TIENDA_WEB: Integer read GetTIENDA_WEBValue write SetTIENDA_WEBValue;
property TIENDA_WEB: Integer read GetTIENDA_WEBValue write SetTIENDA_WEBValue;
property EMAIL_ADMINISTRACION: String read GetEMAIL_ADMINISTRACIONValue write SetEMAIL_ADMINISTRACIONValue;
end;
IBizAgente = interface (IBizContacto)
@ -224,6 +232,9 @@ type
function GetDescuentos: IBizClienteDescuentos;
procedure SetDescuentos(Value: IBizClienteDescuentos);
function GetEMAIL_ADMINISTRACIONValue: String;
procedure SetEMAIL_ADMINISTRACIONValue(const aValue: String);
public
procedure IniciarValoresContactoNuevo; override;
constructor Create(aDataTable: TDADataTable); override;
@ -240,7 +251,8 @@ type
property REGIMEN_IVA: String read GetREGIMEN_IVAValue write SetREGIMEN_IVAValue;
property ID_TIPO_IVA: Integer read GetID_TIPO_IVAValue write SetID_TIPO_IVAValue;
property ID_FORMA_PAGO: Integer read GetID_FORMA_PAGOValue write SetID_FORMA_PAGOValue;
property TIENDA_WEB: Integer read GetTIENDA_WEBValue write SetTIENDA_WEBValue;
property TIENDA_WEB: Integer read GetTIENDA_WEBValue write SetTIENDA_WEBValue;
property EMAIL_ADMINISTRACION: String read GetEMAIL_ADMINISTRACIONValue write SetEMAIL_ADMINISTRACIONValue;
end;
@ -261,13 +273,16 @@ type
function GetID_FORMA_PAGOValue: Integer;
procedure SetID_FORMA_PAGOValue(const aValue: Integer);
function GetEMAIL_ADMINISTRACIONValue: String;
procedure SetEMAIL_ADMINISTRACIONValue(const aValue: String);
public
procedure IniciarValoresContactoNuevo; override;
property DESCUENTO: Float read GetDESCUENTOValue write SetDESCUENTOValue;
property REGIMEN_IVA: String read GetREGIMEN_IVAValue write SetREGIMEN_IVAValue;
property ID_TIPO_IVA: Integer read GetID_TIPO_IVAValue write SetID_TIPO_IVAValue;
property ID_FORMA_PAGO: Integer read GetID_FORMA_PAGOValue write SetID_FORMA_PAGOValue;
property TIENDA_WEB: Integer read GetTIENDA_WEBValue write SetTIENDA_WEBValue;
property TIENDA_WEB: Integer read GetTIENDA_WEBValue write SetTIENDA_WEBValue;
property EMAIL_ADMINISTRACION: String read GetEMAIL_ADMINISTRACIONValue write SetEMAIL_ADMINISTRACIONValue;
end;
@ -414,6 +429,11 @@ begin
Result := FDescuentos;
end;
function TBizCliente.GetEMAIL_ADMINISTRACIONValue: String;
begin
result := DataTable.Fields[idx_ClientesEMAIL_ADMINISTRACION].AsString;
end;
function TBizCliente.GetGRUPO_CLIENTEValue: String;
begin
result := DataTable.Fields[idx_ClientesGRUPO_CLIENTE].AsString;
@ -460,6 +480,11 @@ begin
EnlazarMaestroDetalle(FDescuentosLink, FDescuentos);
end;
procedure TBizCliente.SetEMAIL_ADMINISTRACIONValue(const aValue: String);
begin
DataTable.Fields[idx_ClientesEMAIL_ADMINISTRACION].AsString := aValue;
end;
procedure TBizCliente.SetGRUPO_CLIENTEValue(const aValue: String);
begin
DataTable.Fields[idx_ClientesGRUPO_CLIENTE].AsString := aValue;
@ -543,6 +568,11 @@ end;
{ TBizProveedor }
function TBizProveedor.GetEMAIL_ADMINISTRACIONValue: String;
begin
result := DataTable.Fields[idx_ProveedoresEMAIL_ADMINISTRACION].AsString;
end;
function TBizProveedor.GetID_FORMA_PAGOValue: Integer;
begin
result := DataTable.Fields[idx_ProveedoresID_FORMA_PAGO].AsInteger;
@ -580,6 +610,11 @@ begin
DataTable.Fields[idx_ProveedoresDESCUENTO].AsFloat := aValue;
end;
procedure TBizProveedor.SetEMAIL_ADMINISTRACIONValue(const aValue: String);
begin
DataTable.Fields[idx_ProveedoresEMAIL_ADMINISTRACION].AsString := aValue;
end;
procedure TBizProveedor.SetID_FORMA_PAGOValue(const aValue: Integer);
begin
DataTable.Fields[idx_ProveedoresID_FORMA_PAGO].AsInteger := aValue;

148
Source/Modulos/Contactos/Servidor/srvContactos_Impl.dfm
View File

@ -1,7 +1,6 @@
object srvContactos: TsrvContactos
OldCreateOrder = True
OnCreate = DARemoteServiceCreate
RequiresSession = True
AcquireConnection = True
ConnectionName = 'IBX'
ServiceSchema = schContactos
@ -654,7 +653,7 @@ object srvContactos: TsrvContactos
' ID_AGENTE, GRUPO_CLIENTE, NOMBRE_COMERCIAL, VENCIMIENTO_FACT' +
'URAS, '#10' BLOQUEADO, MOTIVO_BLOQUEO, RECARGO_EQUIVALENCIA, REGI' +
'MEN_IVA, '#10' ID_TIPO_IVA, ID_FORMA_PAGO, TIENDA_WEB, AGENTE, RA' +
'PEL'#10' FROM'#10' V_CLIENTES'
'PEL, EMAIL_ADMINISTRACION'#10' FROM'#10' V_CLIENTES'
StatementType = stSQL
ColumnMappings = <
item
@ -796,6 +795,10 @@ object srvContactos: TsrvContactos
item
DatasetField = 'RAPEL'
TableField = 'RAPEL'
end
item
DatasetField = 'EMAIL_ADMINISTRACION'
TableField = 'EMAIL_ADMINISTRACION'
end>
end>
Name = 'Clientes'
@ -1155,9 +1158,7 @@ object srvContactos: TsrvContactos
DataType = datString
Size = 255
BlobType = dabtUnknown
DisplayWidth = 0
DisplayLabel = 'Agente'
Alignment = taLeftJustify
DictionaryEntry = 'Clientes_AGENTE'
InPrimaryKey = False
Calculated = False
Lookup = False
@ -1167,9 +1168,18 @@ object srvContactos: TsrvContactos
Name = 'RAPEL'
DataType = datInteger
BlobType = dabtUnknown
DisplayWidth = 0
DisplayLabel = 'Rapel'
Alignment = taLeftJustify
DictionaryEntry = 'Clientes_RAPEL'
InPrimaryKey = False
Calculated = False
Lookup = False
LookupCache = False
end
item
Name = 'EMAIL_ADMINISTRACION'
DataType = datString
Size = 255
BlobType = dabtUnknown
DictionaryEntry = 'Clientes_EMAIL_ADMINISTRACION'
InPrimaryKey = False
Calculated = False
Lookup = False
@ -1190,7 +1200,7 @@ object srvContactos: TsrvContactos
'_2, '#10' MOVIL_1, MOVIL_2, FAX, EMAIL_1, EMAIL_2, PAGINA_WEB, '#10' ' +
' NOTAS, FECHA_ALTA, FECHA_MODIFICACION, USUARIO, ID_EMPRESA, '#10 +
' REGIMEN_IVA, DESCUENTO, ID_TIPO_IVA, ID_FORMA_PAGO, TIENDA_W' +
'EB'#10' FROM'#10' V_PROVEEDORES'
'EB,'#10' EMAIL_ADMINISTRACION'#10' FROM'#10' V_PROVEEDORES'
StatementType = stSQL
ColumnMappings = <
item
@ -1296,6 +1306,14 @@ object srvContactos: TsrvContactos
item
DatasetField = 'ID_FORMA_PAGO'
TableField = 'ID_FORMA_PAGO'
end
item
DatasetField = 'TIENDA_WEB'
TableField = 'TIENDA_WEB'
end
item
DatasetField = 'EMAIL_ADMINISTRACION'
TableField = 'EMAIL_ADMINISTRACION'
end>
end>
Name = 'Proveedores'
@ -1581,8 +1599,18 @@ object srvContactos: TsrvContactos
Name = 'TIENDA_WEB'
DataType = datInteger
BlobType = dabtUnknown
DisplayWidth = 0
Alignment = taLeftJustify
DictionaryEntry = 'Proveedores_TIENDA_WEB'
InPrimaryKey = False
Calculated = False
Lookup = False
LookupCache = False
end
item
Name = 'EMAIL_ADMINISTRACION'
DataType = datString
Size = 255
BlobType = dabtUnknown
DictionaryEntry = 'Proveedores_EMAIL_ADMINISTRACION'
InPrimaryKey = False
Calculated = False
Lookup = False
@ -3205,6 +3233,14 @@ object srvContactos: TsrvContactos
BlobType = dabtUnknown
Value = ''
ParamType = daptInput
end
item
Name = 'EMAIL_ADMINISTRACION'
DataType = datString
Size = 255
BlobType = dabtUnknown
Value = ''
ParamType = daptInput
end>
Statements = <
item
@ -3214,11 +3250,12 @@ object srvContactos: TsrvContactos
'INSERT'#10' INTO CLIENTES_DATOS'#10' (ID_CLIENTE, ID_AGENTE, GRUPO_C' +
'LIENTE, RECARGO_EQUIVALENCIA,'#10' NOMBRE_COMERCIAL, VENCIMIENTO' +
'_FACTURAS, BLOQUEADO, MOTIVO_BLOQUEO,'#10' REGIMEN_IVA, ID_TIPO_' +
'IVA, ID_FORMA_PAGO, TIENDA_WEB, RAPEL)'#10' VALUES'#10' (:ID_CLIENTE' +
', :ID_AGENTE, :GRUPO_CLIENTE, :RECARGO_EQUIVALENCIA,'#10' :NOMBR' +
'E_COMERCIAL, :VENCIMIENTO_FACTURAS,'#10' :BLOQUEADO, :MOTIVO_BLO' +
'QUEO, :REGIMEN_IVA,'#10' :ID_TIPO_IVA, :ID_FORMA_PAGO, :TIENDA_W' +
'EB, :RAPEL)'
'IVA, ID_FORMA_PAGO, TIENDA_WEB, RAPEL,'#10' EMAIL_ADMINISTRACION' +
')'#10' VALUES'#10' (:ID_CLIENTE, :ID_AGENTE, :GRUPO_CLIENTE, :RECARG' +
'O_EQUIVALENCIA,'#10' :NOMBRE_COMERCIAL, :VENCIMIENTO_FACTURAS,'#10' ' +
' :BLOQUEADO, :MOTIVO_BLOQUEO, :REGIMEN_IVA,'#10' :ID_TIPO_IVA' +
', :ID_FORMA_PAGO, :TIENDA_WEB, :RAPEL,'#10' :EMAIL_ADMINISTRACIO' +
'N)'
StatementType = stSQL
ColumnMappings = <>
end>
@ -3342,6 +3379,14 @@ object srvContactos: TsrvContactos
Value = ''
ParamType = daptInput
end
item
Name = 'EMAIL_ADMINISTRACION'
DataType = datString
Size = 255
BlobType = dabtUnknown
Value = ''
ParamType = daptInput
end
item
Name = 'OLD_ID_CLIENTE'
DataType = datInteger
@ -3361,8 +3406,8 @@ object srvContactos: TsrvContactos
' VENCIMIENTO_FACTURAS = :VENCIMIENTO_FACTURAS,'#10' BLOQUEADO = ' +
':BLOQUEADO,'#10' REGIMEN_IVA = :REGIMEN_IVA,'#10' ID_TIPO_IVA = :I' +
'D_TIPO_IVA,'#10' ID_FORMA_PAGO = :ID_FORMA_PAGO,'#10' TIENDA_WEB =' +
' :TIENDA_WEB,'#10' RAPEL = :RAPEL'#10' WHERE'#10' (ID_CLIENTE = :OLD_' +
'ID_CLIENTE)'
' :TIENDA_WEB,'#10' RAPEL = :RAPEL,'#10' EMAIL_ADMINISTRACION = :EM' +
'AIL_ADMINISTRACION'#10' WHERE'#10' (ID_CLIENTE = :OLD_ID_CLIENTE)'
StatementType = stSQL
ColumnMappings = <>
end>
@ -3412,6 +3457,14 @@ object srvContactos: TsrvContactos
BlobType = dabtUnknown
Value = ''
ParamType = daptInput
end
item
Name = 'EMAIL_ADMINISTRACION'
DataType = datString
Size = 255
BlobType = dabtUnknown
Value = ''
ParamType = daptInput
end>
Statements = <
item
@ -3419,9 +3472,10 @@ object srvContactos: TsrvContactos
TargetTable = 'PROVEEDORES_DATOS'
SQL =
'INSERT'#10' INTO PROVEEDORES_DATOS'#10' (ID_PROVEEDOR, REGIMEN_IVA, ' +
'DESCUENTO, ID_TIPO_IVA,'#10' ID_FORMA_PAGO, TIENDA_WEB)'#10' VALUES'#10 +
' (:ID_PROVEEDOR, :REGIMEN_IVA, :DESCUENTO, :ID_TIPO_IVA,'#10' ' +
':ID_FORMA_PAGO, :TIENDA_WEB)'
'DESCUENTO, ID_TIPO_IVA,'#10' ID_FORMA_PAGO, TIENDA_WEB, EMAIL_ADM' +
'INISTRACION)'#10' VALUES'#10' (:ID_PROVEEDOR, :REGIMEN_IVA, :DESCUEN' +
'TO, :ID_TIPO_IVA,'#10' :ID_FORMA_PAGO, :TIENDA_WEB, :EMAIL_ADMINI' +
'STRACION)'
StatementType = stSQL
ColumnMappings = <>
end>
@ -3493,6 +3547,14 @@ object srvContactos: TsrvContactos
Value = ''
ParamType = daptInput
end
item
Name = 'EMAIL_ADMINISTRACION'
DataType = datString
Size = 255
BlobType = dabtUnknown
Value = ''
ParamType = daptInput
end
item
Name = 'OLD_ID_PROVEEDOR'
DataType = datInteger
@ -3508,8 +3570,8 @@ object srvContactos: TsrvContactos
'UPDATE PROVEEDORES_DATOS'#10' SET '#10' ID_PROVEEDOR = :ID_PROVEEDOR' +
', '#10' REGIMEN_IVA = :REGIMEN_IVA,'#10' DESCUENTO = :DESCUENTO,'#10' ' +
' ID_TIPO_IVA = :ID_TIPO_IVA,'#10' ID_FORMA_PAGO = :ID_FORMA_PAG' +
'O,'#10' TIENDA_WEB = :TIENDA_WEB'#10' WHERE'#10' (ID_PROVEEDOR = :OLD' +
'_ID_PROVEEDOR)'
'O,'#10' TIENDA_WEB = :TIENDA_WEB,'#10' EMAIL_ADMINISTRACION = :EMA' +
'IL_ADMINISTRACION'#10' WHERE'#10' (ID_PROVEEDOR = :OLD_ID_PROVEEDOR)'
StatementType = stSQL
ColumnMappings = <>
end>
@ -4735,6 +4797,40 @@ object srvContactos: TsrvContactos
BlobType = dabtUnknown
DisplayWidth = 0
Alignment = taLeftJustify
end
item
Name = 'Clientes_RAPEL'
DataType = datInteger
BlobType = dabtUnknown
DisplayWidth = 0
DisplayLabel = 'Rapel'
Alignment = taLeftJustify
end
item
Name = 'Clientes_EMAIL_ADMINISTRACION'
DataType = datString
Size = 255
BlobType = dabtUnknown
DisplayWidth = 0
DisplayLabel = 'E-mail administrativo'
Alignment = taLeftJustify
end
item
Name = 'Proveedores_TIENDA_WEB'
DataType = datInteger
BlobType = dabtUnknown
DisplayWidth = 0
DisplayLabel = 'TIENDA_WEB'
Alignment = taLeftJustify
end
item
Name = 'Proveedores_EMAIL_ADMINISTRACION'
DataType = datString
Size = 255
BlobType = dabtUnknown
DisplayWidth = 0
DisplayLabel = 'E-mail administrativo'
Alignment = taLeftJustify
end>
Left = 126
Top = 14
@ -4745,9 +4841,9 @@ object srvContactos: TsrvContactos
DiagramData =
'<Diagrams>'#13#10' <Diagram Name="New Diagram" Left="200" Top="200" W' +
'idth="400" Height="300">'#13#10' <Entity Name="DatosBancarios" Left' +
'="479,77" Top="0,00" />'#13#10' <Entity Name="Contactos" Left="223,' +
'77" Top="0,00" />'#13#10' <Entity Name="ContactosCategorias" Left="' +
'0,00" Top="26,50" />'#13#10' </Diagram>'#13#10'</Diagrams>'#13#10
'="479,77" Top="0,00" />'#13#10' <Entity Name="ContactosCategorias" ' +
'Left="0,00" Top="26,50" />'#13#10' <Entity Name="Contactos" Left="2' +
'23,77" Top="0,00" />'#13#10' </Diagram>'#13#10'</Diagrams>'#13#10
end
object bpContactos: TDABusinessProcessor
Schema = schContactos

347
Source/Modulos/Contactos/Views/uEditorCliente.dfm
View File

@ -2,18 +2,18 @@ inherited fEditorCliente: TfEditorCliente
Left = 387
Top = 297
Caption = 'Ficha de cliente'
ClientHeight = 585
ClientWidth = 656
ExplicitWidth = 664
ExplicitHeight = 612
ClientHeight = 665
ClientWidth = 876
ExplicitWidth = 884
ExplicitHeight = 692
PixelsPerInch = 96
TextHeight = 13
inherited JvNavPanelHeader: TJvNavPanelHeader
Width = 656
Width = 876
Caption = 'Ficha de cliente'
ExplicitWidth = 656
ExplicitWidth = 876
inherited Image1: TImage
Left = 629
Left = 849
Picture.Data = {
0A54504E474F626A65637489504E470D0A1A0A0000000D494844520000001800
0000180806000000E0773DF80000000970485973000017120000171201679FD2
@ -49,8 +49,8 @@ inherited fEditorCliente: TfEditorCliente
end
end
inherited TBXDock: TTBXDock
Width = 656
ExplicitWidth = 656
Width = 876
ExplicitWidth = 876
inherited tbxMain: TTBXToolbar
ExplicitWidth = 446
object TBXItem7: TTBXItem [7]
@ -59,23 +59,22 @@ inherited fEditorCliente: TfEditorCliente
end
end
inherited tbxMenu: TTBXToolbar
ExplicitWidth = 656
ExplicitWidth = 876
end
end
inherited pgPaginas: TPageControl
Width = 656
Height = 490
ActivePage = pagDatosComerciales
ExplicitWidth = 656
ExplicitHeight = 490
Width = 876
Height = 570
ExplicitWidth = 876
ExplicitHeight = 570
inherited pagGeneral: TTabSheet
ExplicitWidth = 648
ExplicitHeight = 462
ExplicitWidth = 868
ExplicitHeight = 542
inline frViewCliente1: TfrViewCliente
Left = 0
Top = 0
Width = 648
Height = 462
Width = 868
Height = 542
Align = alClient
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
@ -85,187 +84,209 @@ inherited fEditorCliente: TfEditorCliente
ParentFont = False
TabOrder = 0
ReadOnly = False
ExplicitWidth = 648
ExplicitHeight = 462
ExplicitWidth = 868
ExplicitHeight = 542
inherited dxLayoutControlContacto: TdxLayoutControl
Width = 648
Height = 462
Width = 868
Height = 542
LookAndFeel = dxLayoutOfficeLookAndFeel
ExplicitWidth = 648
ExplicitHeight = 462
ExplicitWidth = 868
ExplicitHeight = 542
inherited PngSpeedButton1: TPngSpeedButton
Left = 603
Left = 823
Top = 218
ExplicitLeft = 603
ExplicitLeft = 823
ExplicitTop = 218
end
inherited PngSpeedButton2: TPngSpeedButton
Left = 603
Left = 823
Top = 190
ExplicitLeft = 603
ExplicitLeft = 823
ExplicitTop = 190
end
inherited PngSpeedButton3: TPngSpeedButton
Left = 603
Left = 823
Top = 162
ExplicitLeft = 603
ExplicitLeft = 823
ExplicitTop = 162
end
inherited Label1: TLabel
Left = 429
Top = 270
Left = 445
Top = 367
Width = 269
ExplicitLeft = 429
ExplicitTop = 270
ExplicitLeft = 445
ExplicitTop = 367
ExplicitWidth = 269
end
inherited Label2: TLabel
Left = 445
Top = 270
Width = 271
ExplicitLeft = 445
ExplicitTop = 270
ExplicitWidth = 271
end
inherited PngSpeedButton4: TPngSpeedButton
Left = 823
Top = 315
ExplicitLeft = 823
ExplicitTop = 315
end
inherited eCalle: TcxDBTextEdit
Top = 261
ExplicitTop = 261
ExplicitWidth = 268
Width = 268
Top = 358
ExplicitTop = 358
ExplicitWidth = 246
Width = 246
end
inherited eProvincia: TcxDBTextEdit
Top = 315
ExplicitTop = 315
ExplicitWidth = 268
Width = 268
Top = 412
ExplicitTop = 412
ExplicitWidth = 246
Width = 246
end
inherited ePoblacion: TcxDBTextEdit
Top = 288
ExplicitTop = 288
ExplicitWidth = 78
Width = 78
Top = 385
ExplicitTop = 385
ExplicitWidth = 145
Width = 145
end
inherited eCodigoPostal: TcxDBTextEdit
Left = 336
Top = 288
ExplicitLeft = 336
ExplicitTop = 288
Left = 352
Top = 385
ExplicitLeft = 352
ExplicitTop = 385
end
inherited eObservaciones: TcxDBMemo
Top = 393
ExplicitTop = 393
ExplicitWidth = 587
Top = 463
ExplicitTop = 463
ExplicitWidth = 588
ExplicitHeight = 33
Height = 33
Width = 587
Width = 588
end
inherited eNombreComercial: TcxDBTextEdit
Top = 84
ExplicitTop = 84
ExplicitWidth = 265
Width = 265
ExplicitWidth = 246
Width = 246
end
inherited cbClienteBloqueado: TcxDBCheckBox
Top = 183
ExplicitTop = 183
ExplicitWidth = 163
Width = 163
Top = 280
ExplicitTop = 280
ExplicitWidth = 345
Width = 345
end
inherited cbGrupoCliente: TcxDBComboBox
Top = 111
ExplicitTop = 111
ExplicitWidth = 40
Width = 40
ExplicitWidth = 246
Width = 246
end
inherited eBloqueo: TcxDBTextEdit
Top = 210
ExplicitTop = 210
ExplicitWidth = 205
Width = 205
Top = 307
ExplicitTop = 307
ExplicitWidth = 246
Width = 246
end
inherited cxDBCheckBox1: TcxDBCheckBox
Left = 429
Top = 315
ExplicitLeft = 429
ExplicitTop = 315
ExplicitWidth = 275
Width = 275
Left = 445
Top = 412
ExplicitLeft = 445
ExplicitTop = 412
ExplicitWidth = 351
Width = 351
end
inherited cbRapel: TcxDBCheckBox
Top = 138
ExplicitTop = 138
ExplicitWidth = 345
Width = 345
end
inherited eTlfParticular: TcxDBTextEdit
Left = 524
Left = 557
Top = 57
ExplicitLeft = 524
ExplicitLeft = 557
ExplicitTop = 57
ExplicitWidth = 91
Width = 91
ExplicitWidth = 103
Width = 103
end
inherited eMailAdministracion: TcxDBHyperLinkEdit
Left = 557
Top = 315
ExplicitLeft = 557
ExplicitTop = 315
ExplicitWidth = 74
Width = 74
end
inherited eTlfTrabajo: TcxDBTextEdit
Left = 524
Left = 557
Top = 30
ExplicitLeft = 524
ExplicitLeft = 557
ExplicitTop = 30
ExplicitWidth = 127
Width = 127
ExplicitWidth = 103
Width = 103
end
inherited eTlfMovil: TcxDBTextEdit
Left = 524
Left = 557
Top = 84
ExplicitLeft = 524
ExplicitLeft = 557
ExplicitTop = 84
ExplicitWidth = 140
Width = 140
ExplicitWidth = 103
Width = 103
end
inherited eFax: TcxDBTextEdit
Left = 524
Left = 557
Top = 111
ExplicitLeft = 524
ExplicitLeft = 557
ExplicitTop = 111
ExplicitWidth = 121
Width = 121
ExplicitWidth = 103
Width = 103
end
inherited eNombre: TcxDBTextEdit
Top = 57
ExplicitTop = 57
ExplicitWidth = 158
Width = 158
ExplicitWidth = 246
Width = 246
end
inherited eNIFCIF: TcxDBTextEdit
Left = 220
Left = 226
Top = 30
ExplicitLeft = 220
ExplicitLeft = 226
ExplicitTop = 30
ExplicitWidth = 268
Width = 268
ExplicitWidth = 160
Width = 160
end
inherited eMailTrabajo: TcxDBHyperLinkEdit
Left = 524
Left = 557
Top = 162
Properties.Prefix = 'mailto:'
ExplicitLeft = 524
ExplicitLeft = 557
ExplicitTop = 162
ExplicitWidth = 121
Width = 121
end
inherited cbRapel: TcxDBCheckBox
Top = 366
ExplicitTop = 366
ExplicitWidth = 285
Width = 285
ExplicitWidth = 74
Width = 74
end
inherited eMailParticular: TcxDBHyperLinkEdit
Left = 524
Left = 557
Top = 190
Properties.Prefix = 'mailto:'
ExplicitLeft = 524
ExplicitLeft = 557
ExplicitTop = 190
ExplicitWidth = 121
Width = 121
ExplicitWidth = 74
Width = 74
end
inherited ePaginaWeb: TcxDBHyperLinkEdit
Left = 524
Left = 557
Top = 217
ExplicitLeft = 524
ExplicitLeft = 557
ExplicitTop = 217
ExplicitWidth = 121
Width = 121
ExplicitWidth = 74
Width = 74
end
inherited eReferencia: TcxDBTextEdit
Top = 30
ExplicitTop = 30
ExplicitWidth = 102
Width = 102
ExplicitWidth = 33
Width = 33
end
end
inherited dsContacto: TDADataSource
@ -275,34 +296,34 @@ inherited fEditorCliente: TfEditorCliente
end
end
inherited pagDatosBancarios: TTabSheet
ExplicitWidth = 648
ExplicitHeight = 462
ExplicitWidth = 868
ExplicitHeight = 542
inherited frViewClienteDatosBancarios: TfrViewClienteDatosBancarios
Width = 648
Height = 462
ExplicitWidth = 648
ExplicitHeight = 462
Width = 868
Height = 542
ExplicitWidth = 868
ExplicitHeight = 542
inherited dxLayoutControl1: TdxLayoutControl
Width = 648
Width = 868
LookAndFeel = dxLayoutOfficeLookAndFeel
ExplicitWidth = 648
ExplicitWidth = 868
inherited eEntidad: TcxDBTextEdit
ExplicitWidth = 114
Width = 114
ExplicitWidth = 221
Width = 221
end
inherited eSucursal: TcxDBTextEdit
Left = 418
ExplicitLeft = 418
ExplicitWidth = 112
Width = 112
Left = 534
ExplicitLeft = 534
ExplicitWidth = 208
Width = 208
end
inherited eCuenta: TcxDBTextEdit
ExplicitWidth = 194
Width = 194
ExplicitWidth = 388
Width = 388
end
inherited eTitular: TcxDBTextEdit
ExplicitWidth = 194
Width = 194
ExplicitWidth = 509
Width = 509
end
end
end
@ -313,7 +334,7 @@ inherited fEditorCliente: TfEditorCliente
inline frViewClienteDatosComerciales1: TfrViewClienteDatosComerciales
Left = 0
Top = 0
Width = 648
Width = 868
Height = 193
Align = alTop
Font.Charset = DEFAULT_CHARSET
@ -324,20 +345,20 @@ inherited fEditorCliente: TfEditorCliente
ParentFont = False
TabOrder = 0
ReadOnly = False
ExplicitWidth = 648
ExplicitWidth = 868
ExplicitHeight = 193
inherited dxLayoutControl1: TdxLayoutControl
Width = 648
Width = 868
LookAndFeel = dxLayoutOfficeLookAndFeel
ExplicitWidth = 648
ExplicitWidth = 868
inherited Label1: TLabel
Left = 337
Left = 482
Top = 30
Width = 279
Caption =
'Puede indicar el d'#237'a de mes que el cliente desea realizar el pag' +
'o de sus recibos.'
ExplicitLeft = 337
ExplicitLeft = 482
ExplicitTop = 30
ExplicitWidth = 279
end
@ -348,9 +369,9 @@ inherited fEditorCliente: TfEditorCliente
Width = 197
end
inherited eDiasVencimiento: TcxDBSpinEdit
Left = 466
Left = 611
Top = 62
ExplicitLeft = 466
ExplicitLeft = 611
ExplicitTop = 62
ExplicitWidth = 160
Width = 160
@ -374,9 +395,9 @@ inherited fEditorCliente: TfEditorCliente
Width = 121
end
inherited bFormasPago: TButton
Left = 177
Left = 322
Top = 57
ExplicitLeft = 177
ExplicitLeft = 322
ExplicitTop = 57
end
inherited eIVA: TcxDBLookupComboBox
@ -386,9 +407,9 @@ inherited fEditorCliente: TfEditorCliente
Width = 121
end
inherited bTiposIVA: TButton
Left = 177
Left = 322
Top = 84
ExplicitLeft = 177
ExplicitLeft = 322
ExplicitTop = 84
end
inherited dxLayoutGroup1: TdxLayoutGroup
@ -407,8 +428,8 @@ inherited fEditorCliente: TfEditorCliente
inline frViewDireccionesEntrega1: TfrViewDireccionesEntrega
Left = 0
Top = 0
Width = 648
Height = 462
Width = 868
Height = 542
Align = alClient
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
@ -418,11 +439,11 @@ inherited fEditorCliente: TfEditorCliente
ParentFont = False
TabOrder = 0
ReadOnly = False
ExplicitWidth = 648
ExplicitHeight = 462
ExplicitWidth = 868
ExplicitHeight = 542
inherited cxGrid: TcxGrid
Width = 648
Height = 437
Width = 868
Height = 517
ExplicitWidth = 648
ExplicitHeight = 437
inherited cxGridView: TcxGridDBTableView
@ -433,7 +454,7 @@ inherited fEditorCliente: TfEditorCliente
end
end
inherited ToolBar1: TToolBar
Width = 648
Width = 868
ExplicitWidth = 648
inherited ToolButton1: TToolButton
ExplicitWidth = 62
@ -456,8 +477,8 @@ inherited fEditorCliente: TfEditorCliente
inline frViewClienteDescuentos1: TfrViewClienteDescuentos
Left = 0
Top = 0
Width = 648
Height = 462
Width = 868
Height = 542
Align = alClient
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
@ -467,16 +488,16 @@ inherited fEditorCliente: TfEditorCliente
ParentFont = False
TabOrder = 0
ReadOnly = False
ExplicitWidth = 648
ExplicitHeight = 462
ExplicitWidth = 868
ExplicitHeight = 542
inherited cxGrid: TcxGrid
Width = 648
Height = 437
Width = 868
Height = 517
ExplicitWidth = 648
ExplicitHeight = 437
end
inherited ToolBar1: TToolBar
Width = 648
Width = 868
ExplicitWidth = 648
inherited ToolButton1: TToolButton
ExplicitWidth = 62
@ -495,10 +516,10 @@ inherited fEditorCliente: TfEditorCliente
end
end
inherited StatusBar: TJvStatusBar
Top = 566
Width = 656
ExplicitTop = 566
ExplicitWidth = 656
Top = 646
Width = 876
ExplicitTop = 646
ExplicitWidth = 876
end
inherited EditorActionList: TActionList
object actGruposCliente: TAction

163
Source/Modulos/Contactos/Views/uEditorProveedor.dfm
View File

@ -1,11 +1,16 @@
inherited fEditorProveedor: TfEditorProveedor
Caption = 'fEditorProveedor'
ClientHeight = 548
ExplicitHeight = 582
ClientWidth = 711
ExplicitWidth = 719
ExplicitHeight = 575
PixelsPerInch = 96
TextHeight = 13
inherited JvNavPanelHeader: TJvNavPanelHeader
Width = 711
ExplicitWidth = 711
inherited Image1: TImage
Left = 684
Picture.Data = {
0A54504E474F626A65637489504E470D0A1A0A0000000D494844520000001800
0000180806000000E0773DF80000000970485973000017120000171201679FD2
@ -37,17 +42,28 @@ inherited fEditorProveedor: TfEditorProveedor
53E455B24CEC73DC4C85458EFF01E6EED94CEECC67C7743ED232004BE73E31E6
B992BA678CF4E6B8E28E80C5A533EE99B823605FC347F7FC8F360A98C836E180
FF01702244FEF5B056BE0000000049454E44AE426082}
ExplicitLeft = 684
end
end
inherited TBXDock: TTBXDock
Width = 711
ExplicitWidth = 711
inherited tbxMenu: TTBXToolbar
ExplicitWidth = 711
end
end
inherited pgPaginas: TPageControl
Width = 711
Height = 453
ExplicitWidth = 711
ExplicitHeight = 453
inherited pagGeneral: TTabSheet
ExplicitWidth = 703
ExplicitHeight = 425
inline frViewProveedor1: TfrViewProveedor
Left = 0
Top = 0
Width = 624
Width = 703
Height = 425
Align = alClient
Font.Charset = DEFAULT_CHARSET
@ -58,63 +74,75 @@ inherited fEditorProveedor: TfEditorProveedor
ParentFont = False
TabOrder = 0
ReadOnly = False
ExplicitWidth = 624
ExplicitWidth = 703
ExplicitHeight = 425
inherited dxLayoutControlContacto: TdxLayoutControl
Width = 624
Width = 703
Height = 425
LookAndFeel = dxLayoutOfficeLookAndFeel
ExplicitWidth = 624
ExplicitWidth = 703
ExplicitHeight = 425
inherited PngSpeedButton1: TPngSpeedButton
Left = 579
Left = 658
Top = 218
ExplicitLeft = 579
ExplicitLeft = 658
ExplicitTop = 218
end
inherited PngSpeedButton2: TPngSpeedButton
Left = 579
Left = 658
Top = 190
ExplicitLeft = 579
ExplicitLeft = 658
ExplicitTop = 190
end
inherited PngSpeedButton3: TPngSpeedButton
Left = 579
Left = 658
Top = 162
ExplicitLeft = 579
ExplicitLeft = 658
ExplicitTop = 162
end
inherited Label1: TLabel
Left = 368
Left = 365
Top = 297
Width = 342
ExplicitLeft = 368
ExplicitLeft = 365
ExplicitTop = 297
ExplicitWidth = 342
end
inherited Label2: TLabel
Top = 256
Width = 324
ExplicitTop = 256
ExplicitWidth = 324
end
inherited PngSpeedButton4: TPngSpeedButton
Left = 314
Top = 301
ExplicitLeft = 314
ExplicitTop = 301
end
inherited eCalle: TcxDBTextEdit
Top = 248
ExplicitTop = 248
Top = 151
ExplicitTop = 151
ExplicitWidth = 174
Width = 174
end
inherited eProvincia: TcxDBTextEdit
Top = 302
ExplicitTop = 302
Top = 205
ExplicitTop = 205
ExplicitWidth = 174
Width = 174
end
inherited ePoblacion: TcxDBTextEdit
Top = 275
ExplicitTop = 275
Top = 178
ExplicitTop = 178
ExplicitWidth = 108
Width = 108
end
inherited eCodigoPostal: TcxDBTextEdit
Left = 275
Top = 275
ExplicitLeft = 275
ExplicitTop = 275
Left = 272
Top = 178
ExplicitLeft = 272
ExplicitTop = 178
end
inherited eObservaciones: TcxDBMemo
Top = 353
@ -124,46 +152,52 @@ inherited fEditorProveedor: TfEditorProveedor
Height = 56
Width = 580
end
inherited cxDBCheckBox1: TcxDBCheckBox
Left = 365
Top = 270
ExplicitLeft = 365
ExplicitTop = 270
ExplicitWidth = 218
Width = 218
end
inherited eTlfParticular: TcxDBTextEdit
Left = 463
Left = 460
Top = 57
ExplicitLeft = 463
ExplicitLeft = 460
ExplicitTop = 57
ExplicitWidth = 172
Width = 172
end
inherited cxDBCheckBox1: TcxDBCheckBox
Left = 368
Top = 270
ExplicitLeft = 368
ExplicitTop = 270
ExplicitWidth = 310
Width = 310
end
inherited eTlfTrabajo: TcxDBTextEdit
Left = 463
Left = 460
Top = 30
ExplicitLeft = 463
ExplicitLeft = 460
ExplicitTop = 30
ExplicitWidth = 172
Width = 172
end
inherited eTlfMovil: TcxDBTextEdit
Left = 463
Left = 460
Top = 84
ExplicitLeft = 463
ExplicitLeft = 460
ExplicitTop = 84
ExplicitWidth = 172
Width = 172
end
inherited eFax: TcxDBTextEdit
Left = 463
Left = 460
Top = 111
ExplicitLeft = 463
ExplicitLeft = 460
ExplicitTop = 111
ExplicitWidth = 172
Width = 172
end
inherited eMailAdministracion: TcxDBHyperLinkEdit
Top = 301
ExplicitTop = 301
ExplicitWidth = 33
Width = 33
end
inherited eNombre: TcxDBTextEdit
Top = 57
ExplicitTop = 57
@ -171,35 +205,33 @@ inherited fEditorProveedor: TfEditorProveedor
Width = 263
end
inherited eNIFCIF: TcxDBTextEdit
Left = 181
Top = 30
ExplicitLeft = 181
ExplicitTop = 30
ExplicitWidth = 254
Width = 254
end
inherited eMailTrabajo: TcxDBHyperLinkEdit
Left = 463
Left = 460
Top = 162
Properties.Prefix = 'mailto:'
ExplicitLeft = 463
ExplicitLeft = 460
ExplicitTop = 162
ExplicitWidth = 129
Width = 129
ExplicitWidth = 396
Width = 396
end
inherited eMailParticular: TcxDBHyperLinkEdit
Left = 463
Left = 460
Top = 190
Properties.Prefix = 'mailto:'
ExplicitLeft = 463
ExplicitLeft = 460
ExplicitTop = 190
ExplicitWidth = 165
Width = 165
end
inherited ePaginaWeb: TcxDBHyperLinkEdit
Left = 463
Left = 460
Top = 217
ExplicitLeft = 463
ExplicitLeft = 460
ExplicitTop = 217
ExplicitWidth = 165
Width = 165
@ -214,13 +246,20 @@ inherited fEditorProveedor: TfEditorProveedor
end
end
inherited pagDatosBancarios: TTabSheet
ExplicitWidth = 703
ExplicitHeight = 425
inherited frViewClienteDatosBancarios: TfrViewClienteDatosBancarios
Width = 703
Height = 425
ExplicitWidth = 703
ExplicitHeight = 425
inherited dxLayoutControl1: TdxLayoutControl
Width = 703
LookAndFeel = dxLayoutOfficeLookAndFeel
ExplicitWidth = 703
inherited eSucursal: TcxDBTextEdit
Left = 399
ExplicitLeft = 399
ExplicitWidth = 177
Width = 177
end
@ -241,7 +280,7 @@ inherited fEditorProveedor: TfEditorProveedor
inline frViewProveedorDatosComerciales1: TfrViewProveedorDatosComerciales
Left = 0
Top = 0
Width = 624
Width = 703
Height = 121
Align = alTop
Font.Charset = DEFAULT_CHARSET
@ -252,17 +291,17 @@ inherited fEditorProveedor: TfEditorProveedor
ParentFont = False
TabOrder = 0
ReadOnly = False
ExplicitWidth = 624
ExplicitWidth = 703
ExplicitHeight = 121
inherited dxLayoutControl1: TdxLayoutControl
Width = 624
Width = 703
LookAndFeel = dxLayoutOfficeLookAndFeel
ExplicitWidth = 624
ExplicitWidth = 703
inherited Label1: TLabel
Left = 405
Left = 455
Top = 30
Width = 190
ExplicitLeft = 405
ExplicitLeft = 455
ExplicitTop = 30
ExplicitWidth = 190
end
@ -279,9 +318,9 @@ inherited fEditorProveedor: TfEditorProveedor
Width = 121
end
inherited bFormasPago: TButton
Left = 245
Left = 295
Top = 57
ExplicitLeft = 245
ExplicitLeft = 295
ExplicitTop = 57
end
inherited eIVA: TcxDBLookupComboBox
@ -291,15 +330,15 @@ inherited fEditorProveedor: TfEditorProveedor
Width = 121
end
inherited bTiposIVA: TButton
Left = 245
Left = 295
Top = 84
ExplicitLeft = 245
ExplicitLeft = 295
ExplicitTop = 84
end
inherited eDescuento: TcxDBSpinEdit
Left = 449
Left = 499
Top = 62
ExplicitLeft = 449
ExplicitLeft = 499
ExplicitTop = 62
ExplicitWidth = 73
Width = 73
@ -310,7 +349,9 @@ inherited fEditorProveedor: TfEditorProveedor
end
inherited StatusBar: TJvStatusBar
Top = 529
Width = 711
ExplicitTop = 529
ExplicitWidth = 711
end
inherited EditorActionList: TActionList
Left = 32

357
Source/Modulos/Contactos/Views/uViewCliente.dfm
View File

@ -11,26 +11,20 @@ inherited frViewCliente: TfrViewCliente
ExplicitWidth = 646
ExplicitHeight = 470
inherited PngSpeedButton1: TPngSpeedButton
Left = 584
Top = 219
ExplicitLeft = 584
ExplicitTop = 219
Left = 585
ExplicitLeft = 585
end
inherited PngSpeedButton2: TPngSpeedButton
Left = 584
Top = 191
ExplicitLeft = 584
ExplicitTop = 191
Left = 585
ExplicitLeft = 585
end
inherited PngSpeedButton3: TPngSpeedButton
Left = 584
Top = 163
ExplicitLeft = 584
ExplicitTop = 163
Left = 585
ExplicitLeft = 585
end
object Label1: TLabel [3]
Left = 329
Top = 277
Left = 334
Top = 383
Width = 269
Height = 39
Margins.Bottom = 0
@ -39,52 +33,89 @@ inherited frViewCliente: TfrViewCliente
'riamente debe tener indicado un correo electr'#243'nico de trabajo'
WordWrap = True
end
object Label2: TLabel [4]
Left = 334
Top = 280
Width = 271
Height = 39
Margins.Bottom = 0
Caption =
'Si procede, indique la direcci'#243'n de correo electr'#243'nico del clien' +
'te que se utilizar'#225' para enviar documentaci'#243'n (facturas, albaran' +
'es, recibos, etc.) por e-mail.'
WordWrap = True
end
object PngSpeedButton4: TPngSpeedButton [5]
Left = 585
Top = 325
Width = 23
Height = 22
Action = actMandarCorreoTrabajo
PngImage.Data = {
89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
610000000970485973000017120000171201679FD252000001964944415478DA
63FCFFFF3F03232323033A58BCE9F87F647EAC9F258622B05E6C068034873B8A
80D92019C62F8F194C1356339CDF399D91A0014B361FFB1FE6208AA299E1F323
306D52F90CC5100C03566E3DFC3FD04E02A2F9F727064690462066006A66FC02
64FFFAC8603451096E088A01CB361FFDFF8F819981183077D11A86FDAB7B18E1
062CDD7CE27F14573FC3B2EF450CD13E86181ABE7DFFCDF0F5DB6F866FDFFE30
1CB97897218AB38FC1B85B98E1DC8E698C600396000D8861696058FAB7116CC0
94C5FBB0DAEC6CAECF70EED6238668E67AB057500CF8F0E10383A0A0208A0B90
6D06B1BF01D9379E3C67387AFE09C389A37BD15CE06B01B47907434EAC13C3EF
3F7F19662E3F8862BB898606C3EFDFFF1896EF3DCFA0A5C0CD306FE9265403FC
9D20362F5CB71F4CE7C47AA01890D5BC164C7716F980D56018606BAC0656B079
EF2986F82047AC6150DEB785A13CD911AC06C300234D05867DC72F30B8D818E1
8DC2494B0E63F702281075D455884A07576EDEC134404A5480E1DAED07441900
021806F44D5D44B46618801B400900007F4518F05E90AAF20000000049454E44
AE426082}
PngOptions = [pngBlendOnDisabled, pngGrayscaleOnDisabled]
end
inherited eCalle: TcxDBTextEdit
Left = 121
Top = 268
TabOrder = 7
Top = 374
TabOrder = 8
ExplicitLeft = 121
ExplicitTop = 268
ExplicitTop = 374
ExplicitWidth = 175
Width = 175
end
inherited eProvincia: TcxDBTextEdit
Left = 121
Top = 322
TabOrder = 10
Top = 428
TabOrder = 11
ExplicitLeft = 121
ExplicitTop = 322
ExplicitTop = 428
ExplicitWidth = 167
Width = 167
end
inherited ePoblacion: TcxDBTextEdit
Left = 121
Top = 295
TabOrder = 8
Top = 401
TabOrder = 9
ExplicitLeft = 121
ExplicitTop = 295
ExplicitTop = 401
ExplicitWidth = 71
Width = 71
end
inherited eCodigoPostal: TcxDBTextEdit
Left = 234
Top = 295
TabOrder = 9
ExplicitLeft = 234
ExplicitTop = 295
Left = 239
Top = 401
TabOrder = 10
ExplicitLeft = 239
ExplicitTop = 401
end
inherited eObservaciones: TcxDBMemo
Top = 406
TabOrder = 20
ExplicitTop = 406
Top = 485
TabOrder = 21
ExplicitTop = 485
ExplicitWidth = 609
ExplicitHeight = 42
Height = 42
Width = 609
end
object eNombreComercial: TcxDBTextEdit [9]
object eNombreComercial: TcxDBTextEdit [11]
Left = 121
Top = 79
Top = 82
DataBinding.DataField = 'NOMBRE_COMERCIAL'
DataBinding.DataSource = dsContacto
Style.BorderColor = clWindowFrame
@ -102,9 +133,9 @@ inherited frViewCliente: TfrViewCliente
TabOrder = 3
Width = 143
end
object cbClienteBloqueado: TcxDBCheckBox [10]
object cbClienteBloqueado: TcxDBCheckBox [12]
Left = 22
Top = 184
Top = 290
Action = actBloqueoCliente
DataBinding.DataField = 'BLOQUEADO'
DataBinding.DataSource = dsContacto
@ -123,12 +154,12 @@ inherited frViewCliente: TfrViewCliente
StyleFocused.LookAndFeel.NativeStyle = True
StyleHot.LookAndFeel.Kind = lfStandard
StyleHot.LookAndFeel.NativeStyle = True
TabOrder = 5
TabOrder = 6
Width = 163
end
object cbGrupoCliente: TcxDBComboBox [11]
object cbGrupoCliente: TcxDBComboBox [13]
Left = 121
Top = 106
Top = 109
DataBinding.DataField = 'GRUPO_CLIENTE'
DataBinding.DataSource = dsContacto
Properties.ImmediatePost = True
@ -150,9 +181,9 @@ inherited frViewCliente: TfrViewCliente
TabOrder = 4
Width = 87
end
object eBloqueo: TcxDBTextEdit [12]
object eBloqueo: TcxDBTextEdit [14]
Left = 121
Top = 211
Top = 317
DataBinding.DataField = 'MOTIVO_BLOQUEO'
DataBinding.DataSource = dsContacto
Style.BorderColor = clWindowFrame
@ -166,21 +197,12 @@ inherited frViewCliente: TfrViewCliente
StyleFocused.LookAndFeel.NativeStyle = True
StyleHot.LookAndFeel.Kind = lfStandard
StyleHot.LookAndFeel.NativeStyle = True
TabOrder = 6
TabOrder = 7
Width = 113
end
inherited eTlfParticular: TcxDBTextEdit
Left = 424
Top = 52
TabOrder = 12
ExplicitLeft = 424
ExplicitTop = 52
ExplicitWidth = 157
Width = 157
end
object cxDBCheckBox1: TcxDBCheckBox [14]
Left = 329
Top = 322
object cxDBCheckBox1: TcxDBCheckBox [15]
Left = 334
Top = 428
Caption = 'Permitir el acceso de este cliente a la tienda web'
DataBinding.DataField = 'TIENDA_WEB'
DataBinding.DataSource = dsContacto
@ -200,92 +222,12 @@ inherited frViewCliente: TfrViewCliente
StyleFocused.LookAndFeel.NativeStyle = True
StyleHot.LookAndFeel.Kind = lfStandard
StyleHot.LookAndFeel.NativeStyle = True
TabOrder = 18
Width = 275
TabOrder = 20
Width = 274
end
inherited eTlfTrabajo: TcxDBTextEdit
Left = 424
Top = 25
TabOrder = 11
ExplicitLeft = 424
ExplicitTop = 25
ExplicitWidth = 157
Width = 157
end
inherited eTlfMovil: TcxDBTextEdit
Left = 424
Top = 79
TabOrder = 13
ExplicitLeft = 424
ExplicitTop = 79
ExplicitWidth = 157
Width = 157
end
inherited eFax: TcxDBTextEdit
Left = 424
Top = 106
TabOrder = 14
ExplicitLeft = 424
ExplicitTop = 106
ExplicitWidth = 157
Width = 157
end
inherited eNombre: TcxDBTextEdit
Left = 121
Top = 52
ExplicitLeft = 121
ExplicitTop = 52
ExplicitWidth = 135
Width = 135
end
inherited eNIFCIF: TcxDBTextEdit
Left = 228
Top = 25
ExplicitLeft = 228
ExplicitTop = 25
ExplicitWidth = 58
Width = 58
end
inherited eMailTrabajo: TcxDBHyperLinkEdit
Left = 424
Top = 163
Properties.Prefix = 'mailto:'
TabOrder = 15
ExplicitLeft = 424
ExplicitTop = 163
ExplicitWidth = 128
Width = 128
end
inherited eMailParticular: TcxDBHyperLinkEdit
Left = 424
Top = 191
Properties.Prefix = 'mailto:'
TabOrder = 16
ExplicitLeft = 424
ExplicitTop = 191
ExplicitWidth = 128
Width = 128
end
inherited ePaginaWeb: TcxDBHyperLinkEdit
Left = 424
Top = 218
TabOrder = 17
ExplicitLeft = 424
ExplicitTop = 218
ExplicitWidth = 128
Width = 128
end
inherited eReferencia: TcxDBTextEdit
Left = 121
Top = 25
ExplicitLeft = 121
ExplicitTop = 25
ExplicitWidth = 38
Width = 38
end
object cbRapel: TcxDBCheckBox [24]
object cbRapel: TcxDBCheckBox [16]
Left = 22
Top = 379
Top = 136
Caption = 'Este cliente tiene rapel'
DataBinding.DataField = 'RAPEL'
DataBinding.DataSource = dsContacto
@ -304,9 +246,100 @@ inherited frViewCliente: TfrViewCliente
StyleFocused.LookAndFeel.NativeStyle = True
StyleHot.LookAndFeel.Kind = lfStandard
StyleHot.LookAndFeel.NativeStyle = True
TabOrder = 19
TabOrder = 5
OnClick = actBloqueoClienteExecute
Width = 285
Width = 308
end
inherited eTlfParticular: TcxDBTextEdit
Left = 446
TabOrder = 13
ExplicitLeft = 446
ExplicitWidth = 157
Width = 157
end
object eMailAdministracion: TcxDBHyperLinkEdit [18]
Left = 446
Top = 325
DataBinding.DataField = 'EMAIL_ADMINISTRACION'
DataBinding.DataSource = dsContacto
Properties.OnEditValueChanged = eMailAdministracionPropertiesEditValueChanged
Properties.OnValidate = eMailAdministracionPropertiesValidate
Properties.Prefix = 'mailto:'
Style.BorderColor = clWindowFrame
Style.BorderStyle = ebs3D
Style.HotTrack = False
Style.LookAndFeel.Kind = lfStandard
Style.LookAndFeel.NativeStyle = True
StyleDisabled.LookAndFeel.Kind = lfStandard
StyleDisabled.LookAndFeel.NativeStyle = True
StyleFocused.LookAndFeel.Kind = lfStandard
StyleFocused.LookAndFeel.NativeStyle = True
StyleHot.LookAndFeel.Kind = lfStandard
StyleHot.LookAndFeel.NativeStyle = True
TabOrder = 19
Width = 133
end
inherited eTlfTrabajo: TcxDBTextEdit
Left = 446
TabOrder = 12
ExplicitLeft = 446
ExplicitWidth = 157
Width = 157
end
inherited eTlfMovil: TcxDBTextEdit
Left = 446
TabOrder = 14
ExplicitLeft = 446
ExplicitWidth = 157
Width = 157
end
inherited eFax: TcxDBTextEdit
Left = 446
TabOrder = 15
ExplicitLeft = 446
ExplicitWidth = 157
Width = 157
end
inherited eNombre: TcxDBTextEdit
Left = 121
ExplicitLeft = 121
ExplicitWidth = 135
Width = 135
end
inherited eNIFCIF: TcxDBTextEdit
Left = 231
ExplicitLeft = 231
ExplicitWidth = 58
Width = 58
end
inherited eMailTrabajo: TcxDBHyperLinkEdit
Left = 446
Properties.Prefix = 'mailto:'
TabOrder = 16
ExplicitLeft = 446
ExplicitWidth = 158
Width = 158
end
inherited eMailParticular: TcxDBHyperLinkEdit
Left = 446
Properties.Prefix = 'mailto:'
TabOrder = 17
ExplicitLeft = 446
ExplicitWidth = 128
Width = 128
end
inherited ePaginaWeb: TcxDBHyperLinkEdit
Left = 446
TabOrder = 18
ExplicitLeft = 446
ExplicitWidth = 128
Width = 128
end
inherited eReferencia: TcxDBTextEdit
Left = 121
ExplicitLeft = 121
ExplicitWidth = 38
Width = 38
end
inherited dxLayoutControlContactoGroup_Root: TdxLayoutGroup
AutoAligns = [aaHorizontal]
@ -326,9 +359,14 @@ inherited frViewCliente: TfrViewCliente
Control = cbGrupoCliente
ControlOptions.ShowBorder = False
end
object dxLayoutControlContactoItem22: TdxLayoutItem
ShowCaption = False
Control = cbRapel
ControlOptions.ShowBorder = False
end
end
object dxLayoutControlContactoGroup18: TdxLayoutGroup [1]
Caption = 'Bloqueo'
Caption = 'Bloqueo de cliente'
object dxLayoutControlContactoItem26: TdxLayoutItem
AutoAligns = [aaVertical]
AlignHorz = ahClient
@ -348,6 +386,35 @@ inherited frViewCliente: TfrViewCliente
end
end
inherited dxLayoutControlContactoGroup6: TdxLayoutGroup
object dxLayoutControlContactoGroup14: TdxLayoutGroup
Caption = 'Correo electr'#243'nico de administraci'#243'n'
object dxLayoutControlContactoItem23: TdxLayoutItem
ShowCaption = False
Control = Label2
ControlOptions.AutoColor = True
ControlOptions.ShowBorder = False
end
object dxLayoutControlContactoGroup15: TdxLayoutGroup
ShowCaption = False
Hidden = True
LayoutDirection = ldHorizontal
ShowBorder = False
object dxLayoutControlContactoItem27: TdxLayoutItem
AutoAligns = [aaVertical]
AlignHorz = ahClient
Caption = 'Correo administrativo:'
Control = eMailAdministracion
ControlOptions.ShowBorder = False
end
object dxLayoutControlContactoItem28: TdxLayoutItem
AutoAligns = [aaVertical]
AlignHorz = ahRight
ShowCaption = False
Control = PngSpeedButton4
ControlOptions.ShowBorder = False
end
end
end
object dxLayoutControlContactoGroup10: TdxLayoutGroup
AutoAligns = [aaHorizontal]
AlignVert = avClient
@ -367,11 +434,6 @@ inherited frViewCliente: TfrViewCliente
end
end
inherited dxLayoutControlContactoGroup7: TdxLayoutGroup
object dxLayoutControlContactoItem22: TdxLayoutItem [0]
ShowCaption = False
Control = cbRapel
ControlOptions.ShowBorder = False
end
inherited dxLayoutControlContactoItem8: TdxLayoutItem
ControlOptions.MinHeight = 10
end
@ -396,5 +458,10 @@ inherited frViewCliente: TfrViewCliente
Caption = 'Este cliente est'#225' bloqueado'
OnExecute = actBloqueoClienteExecute
end
object actMandarCorreoAdministracion: TAction
Category = 'Correos'
OnExecute = actMandarCorreoAdministracionExecute
OnUpdate = actMandarCorreoAdministracionUpdate
end
end
end

43
Source/Modulos/Contactos/Views/uViewCliente.pas
View File

@ -36,12 +36,26 @@ type
Label1: TLabel;
dxLayoutControlContactoItem22: TdxLayoutItem;
cbRapel: TcxDBCheckBox;
dxLayoutControlContactoItem23: TdxLayoutItem;
Label2: TLabel;
dxLayoutControlContactoGroup14: TdxLayoutGroup;
dxLayoutControlContactoItem27: TdxLayoutItem;
eMailAdministracion: TcxDBHyperLinkEdit;
dxLayoutControlContactoItem28: TdxLayoutItem;
PngSpeedButton4: TPngSpeedButton;
dxLayoutControlContactoGroup15: TdxLayoutGroup;
actMandarCorreoAdministracion: TAction;
procedure cbGrupoClientePropertiesInitPopup(Sender: TObject);
procedure cbGrupoClientePropertiesValidate(Sender: TObject;
var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean);
procedure CustomViewCreate(Sender: TObject);
procedure CustomViewDestroy(Sender: TObject);
procedure actBloqueoClienteExecute(Sender: TObject);
procedure eMailAdministracionPropertiesEditValueChanged(Sender: TObject);
procedure eMailAdministracionPropertiesValidate(Sender: TObject;
var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean);
procedure actMandarCorreoAdministracionExecute(Sender: TObject);
procedure actMandarCorreoAdministracionUpdate(Sender: TObject);
protected
FGrupoController: IGruposClienteController;
procedure SetContacto(const Value: IBizContacto); override;
@ -54,6 +68,9 @@ implementation
uses
uBizGruposCliente;
type
THackcxDBHyperLinkEdit = class(TcxDBHyperLinkEdit);
{ TfrViewCliente }
procedure TfrViewCliente.actBloqueoClienteExecute(Sender: TObject);
@ -62,6 +79,18 @@ begin
eBloqueo.Enabled := cbClienteBloqueado.Checked;
end;
procedure TfrViewCliente.actMandarCorreoAdministracionExecute(Sender: TObject);
begin
inherited;
THackcxDBHyperLinkEdit(eMailTrabajo).DoStart;
end;
procedure TfrViewCliente.actMandarCorreoAdministracionUpdate(Sender: TObject);
begin
inherited;
(Sender as TAction).Enabled := (Length(eMailAdministracion.Text) > 0)
end;
procedure TfrViewCliente.cbGrupoClientePropertiesInitPopup(Sender: TObject);
begin
inherited;
@ -116,6 +145,20 @@ begin
inherited;
end;
procedure TfrViewCliente.eMailAdministracionPropertiesEditValueChanged(
Sender: TObject);
begin
if not VarIsNull((Sender as TcxDBHyperLinkEdit).EditValue) then
(Sender as TcxDBHyperLinkEdit).EditValue := StringReplace((Sender as TcxDBHyperLinkEdit).EditValue, (Sender as TcxDBHyperLinkEdit).Properties.Prefix, '', []);
end;
procedure TfrViewCliente.eMailAdministracionPropertiesValidate(Sender: TObject;
var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean);
begin
if not VarIsNull(DisplayValue) then
DisplayValue := StringReplace(DisplayValue, (Sender as TcxDBHyperLinkEdit).Properties.Prefix, '', []);
end;
procedure TfrViewCliente.SetContacto(const Value: IBizContacto);
begin
inherited;

207
Source/Modulos/Contactos/Views/uViewProveedor.dfm
View File

@ -5,7 +5,7 @@ inherited frViewProveedor: TfrViewProveedor
Height = 454
ExplicitHeight = 454
object Label1: TLabel [3]
Left = 356
Left = 379
Top = 307
Width = 342
Height = 26
@ -14,63 +14,82 @@ inherited frViewProveedor: TfrViewProveedor
'sirve ese proveedor ser'#225'n tambi'#233'n incluidos)'
WordWrap = True
end
object Label2: TLabel [4]
Left = 22
Top = 266
Width = 324
Height = 39
Margins.Bottom = 0
Caption =
'Si procede, indique la direcci'#243'n de correo electr'#243'nico del prove' +
'edor que se utilizar'#225' para enviar documentaci'#243'n (como pedidos) p' +
'or e-mail.'
WordWrap = True
end
object PngSpeedButton4: TPngSpeedButton [5]
Left = 326
Top = 311
Width = 23
Height = 22
Action = actMandarCorreoTrabajo
PngImage.Data = {
89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
610000000970485973000017120000171201679FD252000001964944415478DA
63FCFFFF3F03232323033A58BCE9F87F647EAC9F258622B05E6C068034873B8A
80D92019C62F8F194C1356339CDF399D91A0014B361FFB1FE6208AA299E1F323
306D52F90CC5100C03566E3DFC3FD04E02A2F9F727064690462066006A66FC02
64FFFAC8603451096E088A01CB361FFDFF8F819981183077D11A86FDAB7B18E1
062CDD7CE27F14573FC3B2EF450CD13E86181ABE7DFFCDF0F5DB6F866FDFFE30
1CB97897218AB38FC1B85B98E1DC8E698C600396000D8861696058FAB7116CC0
94C5FBB0DAEC6CAECF70EED6238668E67AB057500CF8F0E10383A0A0208A0B90
6D06B1BF01D9379E3C67387AFE09C389A37BD15CE06B01B47907434EAC13C3EF
3F7F19662E3F8862BB898606C3EFDFFF1896EF3DCFA0A5C0CD306FE9265403FC
9D20362F5CB71F4CE7C47AA01890D5BC164C7716F980D56018606BAC0656B079
EF2986F82047AC6150DEB785A13CD911AC06C300234D05867DC72F30B8D818E1
8DC2494B0E63F702281075D455884A07576EDEC134404A5480E1DAED07441900
021806F44D5D44B46618801B400900007F4518F05E90AAF20000000049454E44
AE426082}
PngOptions = [pngBlendOnDisabled, pngGrayscaleOnDisabled]
end
inherited eCalle: TcxDBTextEdit
Top = 258
ExplicitTop = 258
Left = 134
Top = 155
ExplicitLeft = 134
ExplicitTop = 155
ExplicitWidth = 264
Width = 264
end
inherited eProvincia: TcxDBTextEdit
Top = 312
ExplicitTop = 312
Left = 134
Top = 209
ExplicitLeft = 134
ExplicitTop = 209
ExplicitWidth = 264
Width = 264
end
inherited ePoblacion: TcxDBTextEdit
Top = 285
ExplicitTop = 285
Left = 134
Top = 182
ExplicitLeft = 134
ExplicitTop = 182
ExplicitWidth = 163
Width = 163
end
inherited eCodigoPostal: TcxDBTextEdit
Left = 261
Top = 285
ExplicitLeft = 261
ExplicitTop = 285
Left = 284
Top = 182
ExplicitLeft = 284
ExplicitTop = 182
end
inherited eObservaciones: TcxDBMemo
Top = 369
TabOrder = 15
TabOrder = 16
ExplicitTop = 369
ExplicitHeight = 43
Height = 43
end
inherited eTlfParticular: TcxDBTextEdit
Left = 451
ExplicitLeft = 451
ExplicitWidth = 91
Width = 91
end
inherited eTlfTrabajo: TcxDBTextEdit
Left = 451
ExplicitLeft = 451
ExplicitWidth = 127
Width = 127
end
inherited eTlfMovil: TcxDBTextEdit
Left = 451
ExplicitLeft = 451
ExplicitWidth = 155
Width = 155
end
inherited eFax: TcxDBTextEdit
Left = 451
ExplicitLeft = 451
ExplicitWidth = 121
Width = 121
end
object cxDBCheckBox1: TcxDBCheckBox [13]
Left = 356
object cxDBCheckBox1: TcxDBCheckBox [11]
Left = 379
Top = 280
Caption = 'Incluir este proveedor en la tienda web'
DataBinding.DataField = 'TIENDA_WEB'
@ -91,45 +110,133 @@ inherited frViewProveedor: TfrViewProveedor
StyleFocused.LookAndFeel.NativeStyle = True
StyleHot.LookAndFeel.Kind = lfStandard
StyleHot.LookAndFeel.NativeStyle = True
TabOrder = 14
TabOrder = 15
Width = 310
end
inherited eTlfParticular: TcxDBTextEdit
Left = 474
TabOrder = 9
ExplicitLeft = 474
ExplicitWidth = 91
Width = 91
end
inherited eTlfTrabajo: TcxDBTextEdit
Left = 474
TabOrder = 8
ExplicitLeft = 474
ExplicitWidth = 127
Width = 127
end
inherited eTlfMovil: TcxDBTextEdit
Left = 474
TabOrder = 10
ExplicitLeft = 474
ExplicitWidth = 155
Width = 155
end
inherited eFax: TcxDBTextEdit
Left = 474
TabOrder = 11
ExplicitLeft = 474
ExplicitWidth = 121
Width = 121
end
object eMailAdministracion: TcxDBHyperLinkEdit [16]
Left = 134
Top = 311
DataBinding.DataField = 'EMAIL_ADMINISTRACION'
DataBinding.DataSource = dsContacto
Properties.OnEditValueChanged = eMailAdministracionPropertiesEditValueChanged
Properties.OnValidate = eMailAdministracionPropertiesValidate
Properties.Prefix = 'mailto:'
Style.BorderColor = clWindowFrame
Style.BorderStyle = ebs3D
Style.HotTrack = False
Style.LookAndFeel.Kind = lfStandard
Style.LookAndFeel.NativeStyle = True
StyleDisabled.LookAndFeel.Kind = lfStandard
StyleDisabled.LookAndFeel.NativeStyle = True
StyleFocused.LookAndFeel.Kind = lfStandard
StyleFocused.LookAndFeel.NativeStyle = True
StyleHot.LookAndFeel.Kind = lfStandard
StyleHot.LookAndFeel.NativeStyle = True
TabOrder = 7
Width = 186
end
inherited eNombre: TcxDBTextEdit
Left = 134
ExplicitLeft = 134
ExplicitWidth = 221
Width = 221
end
inherited eNIFCIF: TcxDBTextEdit
Left = 155
ExplicitLeft = 155
Left = 207
ExplicitLeft = 207
ExplicitWidth = 205
Width = 205
end
inherited eMailTrabajo: TcxDBHyperLinkEdit
Left = 451
Left = 474
Properties.Prefix = 'mailto:'
ExplicitLeft = 451
TabOrder = 12
ExplicitLeft = 474
ExplicitWidth = 133
Width = 133
end
inherited eMailParticular: TcxDBHyperLinkEdit
Left = 451
Left = 474
Properties.Prefix = 'mailto:'
ExplicitLeft = 451
TabOrder = 13
ExplicitLeft = 474
ExplicitWidth = 133
Width = 133
end
inherited ePaginaWeb: TcxDBHyperLinkEdit
Left = 451
ExplicitLeft = 451
Left = 474
TabOrder = 14
ExplicitLeft = 474
ExplicitWidth = 133
Width = 133
end
inherited eReferencia: TcxDBTextEdit
Left = 134
ExplicitLeft = 134
ExplicitWidth = 38
Width = 38
end
inherited dxLayoutControlContactoGroup_Root: TdxLayoutGroup
inherited dxLayoutControlContactoGroup9: TdxLayoutGroup
inherited dxLayoutControlContactoGroup4: TdxLayoutGroup
object dxLayoutControlContactoGroup14: TdxLayoutGroup
Caption = 'Correo electr'#243'nico de administraci'#243'n'
object dxLayoutControlContactoItem20: TdxLayoutItem
ShowCaption = False
Control = Label2
ControlOptions.AutoColor = True
ControlOptions.ShowBorder = False
end
object dxLayoutControlContactoGroup15: TdxLayoutGroup
ShowCaption = False
Hidden = True
LayoutDirection = ldHorizontal
ShowBorder = False
object dxLayoutControlContactoItem21: TdxLayoutItem
AutoAligns = [aaVertical]
AlignHorz = ahClient
Caption = 'Correo administrativo:'
Control = eMailAdministracion
ControlOptions.ShowBorder = False
end
object dxLayoutControlContactoItem22: TdxLayoutItem
AutoAligns = [aaVertical]
AlignHorz = ahRight
ShowCaption = False
Control = PngSpeedButton4
ControlOptions.ShowBorder = False
end
end
end
end
inherited dxLayoutControlContactoGroup6: TdxLayoutGroup
object dxLayoutControlContactoGroup10: TdxLayoutGroup
Caption = 'Tienda web'
@ -153,4 +260,10 @@ inherited frViewProveedor: TfrViewProveedor
Left = 32
Top = 88
end
inherited ActionList1: TActionList
object actMandarCorreoAdministrativo: TAction
OnExecute = actMandarCorreoAdministrativoExecute
OnUpdate = actMandarCorreoAdministrativoUpdate
end
end
end

45
Source/Modulos/Contactos/Views/uViewProveedor.pas
View File

@ -20,6 +20,20 @@ type
Label1: TLabel;
dxLayoutControlContactoItem19: TdxLayoutItem;
cxDBCheckBox1: TcxDBCheckBox;
dxLayoutControlContactoItem20: TdxLayoutItem;
Label2: TLabel;
dxLayoutControlContactoItem21: TdxLayoutItem;
eMailAdministracion: TcxDBHyperLinkEdit;
dxLayoutControlContactoItem22: TdxLayoutItem;
PngSpeedButton4: TPngSpeedButton;
dxLayoutControlContactoGroup14: TdxLayoutGroup;
dxLayoutControlContactoGroup15: TdxLayoutGroup;
actMandarCorreoAdministrativo: TAction;
procedure actMandarCorreoAdministrativoExecute(Sender: TObject);
procedure actMandarCorreoAdministrativoUpdate(Sender: TObject);
procedure eMailAdministracionPropertiesEditValueChanged(Sender: TObject);
procedure eMailAdministracionPropertiesValidate(Sender: TObject;
var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean);
private
{ Private declarations }
public
@ -30,4 +44,35 @@ implementation
{$R *.dfm}
type
THackcxDBHyperLinkEdit = class(TcxDBHyperLinkEdit);
procedure TfrViewProveedor.actMandarCorreoAdministrativoExecute(
Sender: TObject);
begin
inherited;
THackcxDBHyperLinkEdit(eMailTrabajo).DoStart;
end;
procedure TfrViewProveedor.actMandarCorreoAdministrativoUpdate(Sender: TObject);
begin
inherited;
(Sender as TAction).Enabled := (Length(eMailAdministracion.Text) > 0)
end;
procedure TfrViewProveedor.eMailAdministracionPropertiesEditValueChanged(
Sender: TObject);
begin
if not VarIsNull((Sender as TcxDBHyperLinkEdit).EditValue) then
(Sender as TcxDBHyperLinkEdit).EditValue := StringReplace((Sender as TcxDBHyperLinkEdit).EditValue, (Sender as TcxDBHyperLinkEdit).Properties.Prefix, '', []);
end;
procedure TfrViewProveedor.eMailAdministracionPropertiesValidate(
Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption;
var Error: Boolean);
begin
if not VarIsNull(DisplayValue) then
DisplayValue := StringReplace(DisplayValue, (Sender as TcxDBHyperLinkEdit).Properties.Prefix, '', []);
end;
end.

3
Source/Modulos/Facturas de cliente/Controller/FacturasCliente_controller.dpk
View File

@ -57,6 +57,7 @@ contains
uIEditorFacturasClientePreview in 'View\uIEditorFacturasClientePreview.pas',
uIEditorElegirArticulosFacturasCliente in 'View\uIEditorElegirArticulosFacturasCliente.pas',
uArticulosFacturaClienteController in 'uArticulosFacturaClienteController.pas',
uIEditorElegirFacturasCliente in 'View\uIEditorElegirFacturasCliente.pas';
uIEditorElegirFacturasCliente in 'View\uIEditorElegirFacturasCliente.pas',
uIDialogListaFacturasEnvioEMail in 'View\uIDialogListaFacturasEnvioEMail.pas';
end.

21
Source/Modulos/Facturas de cliente/Controller/View/uIDialogListaFacturasEnvioEMail.pas Normal file
View File

@ -0,0 +1,21 @@
unit uIDialogListaFacturasEnvioEMail;
interface
uses
uBizFacturasCliente, uFacturasClienteController;
type
IDialogListaFacturasEnvioEMail = interface
['{5B086ADA-7877-4469-ACBE-4C8E4F4BF184}']
function GetFacturas: IBizFacturaCliente;
procedure SetFacturas(const Value: IBizFacturaCliente);
property Facturas: IBizFacturaCliente read GetFacturas write SetFacturas;
function ShowModal : Integer;
procedure Release;
end;
implementation
end.

197
Source/Modulos/Facturas de cliente/Controller/uFacturasClienteController.pas
View File

@ -42,6 +42,13 @@ type
procedure Preview(AFactura : IBizFacturaCliente; AllItems: Boolean = false);
function Print(AFactura : IBizFacturaCliente; AllItems: Boolean = false): Boolean;
function EnviarEmailFacturas(AFacturas : IBizFacturaCliente): Boolean;
function GenerarEmailFactura(AFactura : IBizFacturaCliente): Boolean;
function EnviarFacturaPorEMail(AFactura: IBizFacturaCliente;
const AEnviarDirectamente: Boolean = True;
const ADireccionEMail: String = ''; const AAsuntoEMail: String = '';
const ATextoEMail: String = ''): Boolean;
procedure RecalcularImportes(AFactura: IBizFacturaCliente);
function EsModificable(AFactura: IBizFacturaCliente): Boolean;
function EsEliminable(AFactura: IBizFacturaCliente): Boolean;
@ -70,6 +77,8 @@ type
function ValidarFactura(AFactura: IBizFacturaCliente): Boolean;
procedure GenerarRecibos(AFactura: IBizFacturaCliente);
procedure _AnadirMarcaEnvioCorreo(AFactura: IBizFacturaCliente);
protected
procedure RecibirAviso(ASujeto: ISujeto; ADataTable: IDAStronglyTypedDataTable); override;
public
@ -101,6 +110,15 @@ type
procedure Preview(AFactura : IBizFacturaCliente; AllItems: Boolean = false);
function Print(AFactura : IBizFacturaCliente; AllItems: Boolean = false): Boolean;
function EnviarEmailFacturas(AFacturas : IBizFacturaCliente): Boolean;
function GenerarEmailFactura(AFactura : IBizFacturaCliente): Boolean;
function EnviarFacturaPorEMail(AFactura: IBizFacturaCliente;
const AEnviarDirectamente: Boolean = True;
const ADireccionEMail: String = ''; const AAsuntoEMail: String = '';
const ATextoEMail: String = ''): Boolean;
procedure RecalcularImportes(AFactura: IBizFacturaCliente);
function EsModificable(AFactura: IBizFacturaCliente): Boolean;
function EsEliminable(AFactura: IBizFacturaCliente): Boolean;
@ -118,10 +136,12 @@ uses
uDataModuleUsuarios, uDAInterfaces, uDataTableUtils, uDateUtils,
uAlbaranesClienteController, schAlbaranesClienteClient_Intf, uROTypes, uDetallesAlbaranClienteController,
uBizDetallesAlbaranCliente, uFacturasClienteReportController,
uBizPedidosCliente, uPedidosClienteController,
uBizPedidosCliente, uPedidosClienteController, uIntegerListUtils,
DateUtils, Forms, uBizDetallesPedidoCliente, Dialogs,
uFormasPagoController, uBizFormasPago, uIEditorElegirFacturasCliente,
uRecibosClienteController, uBizRecibosCliente;
uRecibosClienteController, uBizRecibosCliente, uSistemaFunc,
uDialogElegirEMail, uEMailUtils, uStringsUtils,
uIDialogListaFacturasEnvioEMail, uDataModuleRegistroCorreos;
procedure CopiarArticulosPedido(AOrigen: IBizDetallesPedidoCliente;
@ -791,6 +811,100 @@ begin
end;
end;
function TFacturasClienteController.EnviarEmailFacturas(
AFacturas: IBizFacturaCliente): Boolean;
var
ADialog : IDialogListaFacturasEnvioEMail;
ARespuesta : Integer;
begin
ADialog := NIL;
if not Assigned(AFacturas) then
raise Exception.Create ('Facturas no asignadas (EnviarFacturasPorEMail)');
if AFacturas.DataTable.Active then
AFacturas.DataTable.Active := True;
ShowHourglassCursor;
try
CreateEditor('DialogListaFacturasEnvioEMail', IDialogListaFacturasEnvioEMail, ADialog);
if Assigned(ADialog) then
begin
try
ADialog.Facturas := AFacturas;
ARespuesta := ADialog.ShowModal;
Result := (ARespuesta = mrOK)
finally
ADialog.Release;
end;
end;
finally
ADialog := NIL;
HideHourglassCursor;
end;
end;
function TFacturasClienteController.EnviarFacturaPorEMail(
AFactura: IBizFacturaCliente;
const AEnviarDirectamente: Boolean = True;
const ADireccionEMail: String = ''; const AAsuntoEMail: String = '';
const ATextoEMail: String = ''): Boolean;
var
AReportController : IFacturasClienteReportController;
AFicheroTMP : TFileName;
AEMail : String;
AAsunto : String;
AListaEmail : TStringList;
begin
if not Assigned(AFactura) then
raise Exception.Create ('Factura no asignada (EnviarFacturaPorEMail)');
if AFactura.DataTable.Active then
AFactura.DataTable.Active := True;
RecuperarCliente(AFactura);
AFactura.Cliente.DataTable.Active := True;
AFicheroTMP := DarFicheroPDFTemporal(EscapeIllegalChars(AFactura.REFERENCIA));
if not EsCadenaVacia(ADireccionEMail) then
AEMail := ADireccionEMail
else begin
AListaEmail := TStringList.Create;
try
if not EsCadenaVacia(AFactura.Cliente.EMAIL_ADMINISTRACION) then
AListaEmail.Add(AFactura.Cliente.EMAIL_ADMINISTRACION);
if not ElegirEMail(AListaEmail, AEMail) then
Exit;
finally
FreeANDNIL(AListaEmail);
end;
end;
if not EsCadenaVacia(AAsuntoEMail) then
AAsunto := AAsuntoEMail
else
AAsunto := 'Factura ' + AFactura.REFERENCIA;
ShowHourglassCursor;
Application.ProcessMessages;
AReportController := TFacturasClienteReportController.Create;
try
AReportController.ExportToPDF(AFactura.ID, AFicheroTMP);
Result := EnviarEMailMAPI(AAsunto, ATextoEMail, AFicheroTMP, '', '', AFactura.Cliente.NOMBRE, AEMail, AEnviarDirectamente);
if Result then
_AnadirMarcaEnvioCorreo(AFactura);
finally
SysUtils.DeleteFile(AFicheroTMP);
AReportController := NIL;
HideHourglassCursor;
Application.ProcessMessages;
end;
end;
function TFacturasClienteController.EsEliminable(AFactura: IBizFacturaCliente): Boolean;
begin
Result := EsModificable(AFactura);
@ -885,6 +999,37 @@ begin
end;
end;
procedure TFacturasClienteController._AnadirMarcaEnvioCorreo(AFactura: IBizFacturaCliente);
var
ASoloLectura : Boolean;
begin
if not Assigned(AFactura) then
raise Exception.Create ('Factura no asignada (_AnadirMarcaEnvioCorreo)');
if AFactura.DataTable.Active then
AFactura.DataTable.Active := True;
if AnadirMarcaEnvioCorreo(nme_FacturasCliente, AFactura.ID) then
begin
DesconectarTabla(AFactura.DataTable);
try
ASoloLectura := AFactura.DataTable.ReadOnly;
if ASoloLectura then
SetDataTableReadOnly(AFactura.DataTable, False);
try
AFactura.Edit;
AFactura.NUM_CORREOS := AFactura.NUM_CORREOS + 1;
AFactura.Post;
finally
if ASoloLectura then
SetDataTableReadOnly(AFactura.DataTable, True);
end;
finally
ConectarTabla(AFactura.DataTable);
end;
end;
end;
procedure TFacturasClienteController.FiltrarEmpresa(AFactura: IBizFacturaCliente);
begin
if AFactura.DataTable.Active then
@ -916,10 +1061,10 @@ begin
Result := False;
if not Assigned(AFactura) then
raise Exception.Create ('Factura no asignada');
raise Exception.Create ('Factura no asignada (Guardar)');
if not Assigned(FDetallesController) then
raise Exception.Create ('Controller detalles no asignado');
raise Exception.Create ('Controller detalles no asignado (Guardar)');
if ValidarFactura(AFactura) then
begin
@ -961,12 +1106,12 @@ end;
procedure TFacturasClienteController.Preview(AFactura: IBizFacturaCliente; AllItems: Boolean = false);
var
AReportController : IFacturasClienteReportController;
ID_Facturas: TStringList;
ID_Facturas: TIntegerList;
begin
AReportController := TFacturasClienteReportController.Create;
try
ID_Facturas := TStringList.Create;
ID_Facturas := TIntegerList.Create;
//Si deseamos previsualizar todos los items del objeto albaran
if AllItems then
@ -976,33 +1121,32 @@ begin
First;
while not EOF do
begin
ID_Facturas.Add(IntToStr(AFactura.ID));
ID_Facturas.Add(AFactura.ID);
Next;
end;
end;
end
//Solo previsualizamos el item seleccionado
else
ID_Facturas.Add(IntToStr(AFactura.ID));
AReportController.Preview(ID_Facturas.CommaText);
ID_Facturas.Add(AFactura.ID);
AReportController.Preview(ID_Facturas);
finally
AReportController := NIL;
ID_Facturas.Free;
FreeANDNIL(ID_Facturas)
end;
end;
function TFacturasClienteController.Print(AFactura: IBizFacturaCliente; AllItems: Boolean = false): Boolean;
var
AReportController : IFacturasClienteReportController;
ID_Facturas: TStringList;
ID_Facturas: TIntegerList;
begin
Result := False;
AReportController := TFacturasClienteReportController.Create;
try
ID_Facturas := TStringList.Create;
ID_Facturas := TIntegerList.Create;
//Si deseamos previsualizar todos los items del objeto albaran
if AllItems then
@ -1012,20 +1156,19 @@ begin
First;
while not EOF do
begin
ID_Facturas.Add(IntToStr(AFactura.ID));
ID_Facturas.Add(AFactura.ID);
Next;
end;
end;
end
//Solo previsualizamos el item seleccionado
else
ID_Facturas.Add(IntToStr(AFactura.ID));
Result := AReportController.Print(ID_Facturas.CommaText);
ID_Facturas.Add(AFactura.ID);
Result := AReportController.Print(ID_Facturas);
finally
AReportController := NIL;
ID_Facturas.Free;
FreeANDNIL(ID_Facturas)
end;
end;
@ -1049,6 +1192,24 @@ begin
end;
end;
function TFacturasClienteController.GenerarEmailFactura(
AFactura: IBizFacturaCliente): Boolean;
begin
if not Assigned(AFactura) then
raise Exception.Create ('Facturas no asignadas (GenerarEmailFactura)');
if AFactura.DataTable.Active then
AFactura.DataTable.Active := True;
ShowHourglassCursor;
try
RecuperarCliente(AFactura);
EnviarFacturaPorEMail(AFactura, False, AFactura.Cliente.EMAIL_ADMINISTRACION);
finally
HideHourglassCursor;
end;
end;
procedure TFacturasClienteController.GenerarRecibos(AFactura: IBizFacturaCliente);
var
AFormasPagoController : IFormasPagoController;

121
Source/Modulos/Facturas de cliente/Controller/uFacturasClienteReportController.pas
View File

@ -4,14 +4,15 @@ interface
uses
Classes, SysUtils, uDADataTable, uControllerBase, uIDataModuleFacturasClienteReport,
uClientesController, uDetallesFacturaClienteController,
uClientesController, uDetallesFacturaClienteController, uIntegerListUtils,
uBizFacturasCliente;
type
IFacturasClienteReportController = interface
['{A0F41767-4FF6-4BAE-9FC9-894DD721D756}']
procedure Preview(const AFacturaID : String);
function Print(const AFacturaID : String): Boolean;
procedure Preview(const AListaID : TIntegerList);
function Print(const AListaID : TIntegerList): Boolean;
function ExportToPDF(const AID: Integer; const AFileName : String = ''): Boolean;
end;
TFacturasClienteReportController = class(TInterfacedObject, IFacturasClienteReportController)
@ -23,8 +24,12 @@ type
constructor Create;
destructor Destroy; override;
procedure Preview(const AFacturaID : String);
function Print(const AFacturaID : String): Boolean;
procedure Preview(const AListaID : TIntegerList);
function Print(const AListaID : TIntegerList): Boolean;
function ExportToPDF(const AID: Integer; const AFileName : String = ''): Boolean;
{ procedure Preview(const AFacturaID : String);
function Print(const AFacturaID : String): Boolean;}
end;
@ -33,7 +38,7 @@ implementation
uses
uROTypes, uEditorRegistryUtils, uIEditorFacturasClientePreview,
uEditorPreview, uDataModuleFacturasCliente, uEditorBase, cxControls,
schFacturasClienteClient_Intf;
schFacturasClienteClient_Intf, uStringsUtils;
{ TFacturasClienteReportController }
@ -55,56 +60,88 @@ begin
inherited;
end;
procedure TFacturasClienteReportController.Preview(const AFacturaID : String);
function TFacturasClienteReportController.ExportToPDF(const AID: Integer;
const AFileName: String): Boolean;
var
AStream: Binary;
AEditor : IEditorFacturasClientePreview;
begin
AEditor := NIL;
ShowHourglassCursor;
try
AStream := FDataModule.GetReport(AFacturaID);
try
CreateEditor('EditorFacturasClientePreview', IEditorFacturasClientePreview, AEditor);
AEditor.LoadFromStream(AStream);
finally
AStream.Free;
end;
finally
HideHourglassCursor;
end;
if Assigned(AEditor) then
AEditor.Preview;
end;
function TFacturasClienteReportController.Print(const AFacturaID : String): Boolean;
var
AStream: Binary;
AEditor : IEditorFacturasClientePreview;
begin
Result := False;
AEditor := NIL;
if EsCadenaVacia(AFileName) then
Exit;
ShowHourglassCursor;
try
AStream := FDataModule.GetReport(AFacturaID);
AStream := FDataModule.GetRptPDFFacturas(AID, True);
try
CreateEditor('EditorFacturasClientePreview', IEditorFacturasClientePreview, AEditor);
AEditor.LoadFromStream(AStream);
AStream.SaveToFile(AFileName);
Result := True;
finally
AStream.Free;
FreeAndNil(AStream);
end;
finally
HideHourglassCursor;
end;
end;
if Assigned(AEditor) then
begin
AEditor.TablaImpresion := nme_FacturasCliente;
AEditor.IdTablaImpresion := AFacturaID;
Result := AEditor.Print;
procedure TFacturasClienteReportController.Preview(
const AListaID: TIntegerList);
var
AStream: Binary;
AEditor : IEditorFacturasClientePreview;
begin
AEditor := NIL;
ShowHourglassCursor;
try
AStream := FDataModule.GetRptFacturas(AListaID);
try
CreateEditor('EditorFacturasClientePreview', IEditorFacturasClientePreview, AEditor);
if Assigned(AEditor) then
begin
try
AEditor.LoadFromStream(AStream);
AEditor.Preview;
finally
AEditor.Release;
end;
end;
finally
FreeAndNil(AStream);
AEditor := Nil;
end;
finally
HideHourglassCursor;
end;
end;
function TFacturasClienteReportController.Print(const AListaID: TIntegerList): Boolean;
var
AStream: Binary;
AEditor : IEditorFacturasClientePreview;
IdTablaImpresion : String;
begin
AEditor := NIL;
ShowHourglassCursor;
try
AStream := FDataModule.GetRptFacturas(AListaID);
try
CreateEditor('EditorFacturasClientePreview', IEditorFacturasClientePreview, AEditor);
if Assigned(AEditor) then
begin
try
AEditor.LoadFromStream(AStream);
AEditor.TablaImpresion := nme_FacturasCliente;
AEditor.IdTablaImpresion := AListaID.ToString;
Result := AEditor.Print;
finally
AEditor.Release;
end;
end;
finally
FreeAndNil(AStream);
AEditor := Nil;
end;
finally
HideHourglassCursor;
end;
end;

17
Source/Modulos/Facturas de cliente/Data/uDataModuleFacturasCliente.dfm
View File

@ -10,8 +10,8 @@ object DataModuleFacturasCliente: TDataModuleFacturasCliente
ParamType = fResult
DataType = rtString
end>
Height = 414
Width = 518
Height = 407
Width = 480
object RORemoteService: TRORemoteService
ServiceName = 'srvFacturasCliente'
Message = ROBinMessage1
@ -84,7 +84,7 @@ object DataModuleFacturasCliente: TDataModuleFacturasCliente
DataType = datDateTime
BlobType = dabtUnknown
DisplayWidth = 0
DisplayLabel = 'Fecha de las factura'
DisplayLabel = 'Fecha'
Alignment = taLeftJustify
DictionaryEntry = 'FacturasCliente_FECHA_FACTURA'
InPrimaryKey = False
@ -466,6 +466,17 @@ object DataModuleFacturasCliente: TDataModuleFacturasCliente
Lookup = False
LookupCache = False
end
item
Name = 'NUM_CORREOS'
DataType = datInteger
BlobType = dabtUnknown
DisplayWidth = 0
Alignment = taLeftJustify
InPrimaryKey = False
Calculated = False
Lookup = False
LookupCache = False
end
item
Name = 'FECHA_VENCIMIENTO'
DataType = datDateTime

33
Source/Modulos/Facturas de cliente/Data/uDataModuleFacturasCliente.pas
View File

@ -8,7 +8,7 @@ uses
uROServiceComponent, uRORemoteService, uROClient, uROBinMessage,
uIDataModuleFacturasCliente, uBizFacturasCliente, uBizDetallesFacturaCliente,
uDADesigntimeCall, uIDataModuleFacturasClienteReport;
uDADesigntimeCall, uIDataModuleFacturasClienteReport, uIntegerListUtils;
type
TDataModuleFacturasCliente = class(TDAClientDataModule, IDataModuleFacturasCliente, IDataModuleFacturasClienteReport)
@ -33,7 +33,10 @@ type
function NewItem : IBizFacturaCliente;
// Report
function GetReport(const AFacturaID: String; const ShowLogotipo: Boolean = False): Binary;
function GetRptFacturas(const AListaID: TIntegerList;
const ShowLogotipo: Boolean = False): Binary;
function GetRptPDFFacturas(const AID: Integer;
const ShowLogotipo: Boolean = False): Binary;
end;
implementation
@ -65,9 +68,31 @@ begin
Result := (RORemoteService as IsrvFacturasCliente).GetNextAutoInc(aGeneratorName)
end;
function TDataModuleFacturasCliente.GetReport(const AFacturaID: String; const ShowLogotipo: Boolean = False): Binary;
function TDataModuleFacturasCliente.GetRptPDFFacturas(
const AID: Integer; const ShowLogotipo: Boolean = False): Binary;
var
AParam : TIntegerArray;
begin
Result := (RORemoteService as IsrvFacturasCliente).GenerateReport(AFacturaID, ShowLogotipo)
AParam := TIntegerArray.Create;
try
AParam.Add(AID);
Result := (RORemoteService as IsrvFacturasCliente).GenerarInformeEnPDF(AParam, ShowLogotipo)
finally
FreeANDNIL(AParam)
end;
end;
function TDataModuleFacturasCliente.GetRptFacturas(
const AListaID: TIntegerList; const ShowLogotipo: Boolean = False): Binary;
var
AParam : TIntegerArray;
begin
AParam := AListaID.ToIntegerArray;
try
Result := (RORemoteService as IsrvFacturasCliente).GenerarInforme(AParam, ShowLogotipo)
finally
FreeANDNIL(AParam)
end;
end;
function TDataModuleFacturasCliente.NewItem: IBizFacturaCliente;

4
Source/Modulos/Facturas de cliente/FacturasCliente_Group.bdsgroup
View File

@ -23,10 +23,10 @@
<Projects Name="FacturasCliente_model.bpl">Model\FacturasCliente_model.bdsproj</Projects>
<Projects Name="FacturasCliente_data.bpl">Data\FacturasCliente_data.bdsproj</Projects>
<Projects Name="FacturasCliente_controller.bpl">Controller\FacturasCliente_controller.bdsproj</Projects>
<Projects Name="AlbCli_FacCli_relation.bpl">..\Relaciones\Albaranes de cliente - Facturas de cliente\AlbCli_FacCli_relation.bdsproj</Projects>
<Projects Name="FacturasCliente_view.bpl">Views\FacturasCliente_view.bdsproj</Projects>
<Projects Name="FactuGES.exe">..\..\Cliente\FactuGES.bdsproj</Projects>
<Projects Name="FactuGES_Server.exe">..\..\Servidor\FactuGES_Server.bdsproj</Projects>
<Projects Name="AlbCli_FacCli_relation.bpl">..\Relaciones\Albaranes de cliente - Facturas de cliente\AlbCli_FacCli_relation.bdsproj</Projects>
<Projects Name="AlbaranesCliente_controller.bpl">..\Albaranes de cliente\Controller\AlbaranesCliente_controller.bdsproj</Projects>
<Projects Name="PedidosCliente_model.bpl">..\Pedidos de cliente\Model\PedidosCliente_model.bdsproj</Projects>
<Projects Name="FacturasProveedor_view.bpl">..\Facturas de proveedor\Views\FacturasProveedor_view.bdsproj</Projects>
@ -35,7 +35,7 @@
<Projects Name="FormasPago_controller.bpl">..\Formas de pago\Controller\FormasPago_controller.bdsproj</Projects>
<Projects Name="FormasPago_view.bpl">..\Formas de pago\Views\FormasPago_view.bdsproj</Projects>
<Projects Name="FormasPago_plugin.bpl">..\Formas de pago\Plugin\FormasPago_plugin.bdsproj</Projects>
<Projects Name="Targets">Base.bpl ControllerBase.bpl GUIBase.bpl Contactos_model.bpl Contactos_data.bpl Contactos_controller.bpl Articulos_view.bpl Articulos_model.bpl Articulos_data.bpl Articulos_controller.bpl Contactos_view.bpl FacturasCliente_model.bpl FacturasCliente_data.bpl FacturasCliente_controller.bpl FacturasCliente_view.bpl FactuGES.exe FactuGES_Server.exe AlbCli_FacCli_relation.bpl AlbaranesCliente_controller.bpl PedidosCliente_model.bpl FacturasProveedor_view.bpl FormasPago_model.bpl FormasPago_data.bpl FormasPago_controller.bpl FormasPago_view.bpl FormasPago_plugin.bpl</Projects>
<Projects Name="Targets">Base.bpl ControllerBase.bpl GUIBase.bpl Contactos_model.bpl Contactos_data.bpl Contactos_controller.bpl Articulos_view.bpl Articulos_model.bpl Articulos_data.bpl Articulos_controller.bpl Contactos_view.bpl FacturasCliente_model.bpl FacturasCliente_data.bpl FacturasCliente_controller.bpl AlbCli_FacCli_relation.bpl FacturasCliente_view.bpl FactuGES.exe FactuGES_Server.exe AlbaranesCliente_controller.bpl PedidosCliente_model.bpl FacturasProveedor_view.bpl FormasPago_model.bpl FormasPago_data.bpl FormasPago_controller.bpl FormasPago_view.bpl FormasPago_plugin.bpl</Projects>
</Projects>
<Dependencies/>
</Default.Personality>

7
Source/Modulos/Facturas de cliente/Model/Data/uIDataModuleFacturasClienteReport.pas
View File

@ -3,12 +3,15 @@ unit uIDataModuleFacturasClienteReport;
interface
uses
SysUtils, Classes, uROTypes;
SysUtils, Classes, uROTypes, uIntegerListUtils;
type
IDataModuleFacturasClienteReport = interface
['{F498AC70-AA38-4C06-B301-85A4AC0B210B}']
function GetReport(const AFacturaID: String; const ShowLogotipo: Boolean = False): Binary;
function GetRptFacturas(const AListaID: TIntegerList;
const ShowLogotipo: Boolean = False): Binary;
function GetRptPDFFacturas(const AID: Integer;
const ShowLogotipo: Boolean = False): Binary;
end;
implementation

2
Source/Modulos/Facturas de cliente/Model/FacturasCliente_model.bdsproj
View File

@ -175,7 +175,7 @@
<Excluded_Packages Name="C:\Archivos de programa\EurekaLog 5\Delphi10\ExceptionExpert10.bpl">EurekaLog 5.1.9</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>
<!-- EurekaLog First Line
<!-- EurekaLog First Line
[Exception Log]
EurekaLog Version=519
Activate=1

40
Source/Modulos/Facturas de cliente/Model/schFacturasClienteClient_Intf.pas
View File

@ -9,11 +9,11 @@ const
{ Data table rules ids
Feel free to change them to something more human readable
but make sure they are unique in the context of your application }
RID_DarReferencia = '{EA572FA1-0901-4EF3-938E-2362AC640EB4}';
RID_FacturasCliente = '{29F1AA5F-3116-4524-9211-1FBD4E374821}';
RID_FacturasCliente_Detalles = '{800AB71B-4277-426A-9227-90DEB5691D1B}';
RID_FacturasCliente_Detalles_Refresh = '{86962468-04E7-46A8-9092-2CB67A9C8386}';
RID_FacturasCliente_Refresh = '{5867B671-2351-490B-9C7F-8FD8FF52F453}';
RID_DarReferencia = '{FC555913-2986-4EBE-BC26-44B6BEB78B8D}';
RID_FacturasCliente = '{78E5BD77-ED50-4C61-BFE6-2BBEA1E6DD50}';
RID_FacturasCliente_Detalles = '{25F1F0F4-FA66-4321-BED9-09766515CF4A}';
RID_FacturasCliente_Detalles_Refresh = '{C916F9D8-6D3C-4CB2-AFF4-EC383EA6E951}';
RID_FacturasCliente_Refresh = '{FDFE263E-2822-4F0F-96BE-01641D043041}';
{ Data table names }
nme_DarReferencia = 'DarReferencia';
@ -63,6 +63,7 @@ const
fld_FacturasClienteREFERENCIA_COMISION = 'REFERENCIA_COMISION';
fld_FacturasClienteID_AGENTE = 'ID_AGENTE';
fld_FacturasClienteNUM_COPIAS = 'NUM_COPIAS';
fld_FacturasClienteNUM_CORREOS = 'NUM_CORREOS';
fld_FacturasClienteFECHA_VENCIMIENTO = 'FECHA_VENCIMIENTO';
{ FacturasCliente field indexes }
@ -100,7 +101,8 @@ const
idx_FacturasClienteREFERENCIA_COMISION = 31;
idx_FacturasClienteID_AGENTE = 32;
idx_FacturasClienteNUM_COPIAS = 33;
idx_FacturasClienteFECHA_VENCIMIENTO = 34;
idx_FacturasClienteNUM_CORREOS = 34;
idx_FacturasClienteFECHA_VENCIMIENTO = 35;
{ FacturasCliente_Detalles fields }
fld_FacturasCliente_DetallesID = 'ID';
@ -243,7 +245,7 @@ const
type
{ IDarReferencia }
IDarReferencia = interface(IDAStronglyTypedDataTable)
['{3256D6AA-181E-4AA4-8C6B-80AB1640194C}']
['{12227F52-D465-4898-B134-D4C16E295BA4}']
{ Property getters and setters }
function GetVALORValue: String;
procedure SetVALORValue(const aValue: String);
@ -272,7 +274,7 @@ type
{ IFacturasCliente }
IFacturasCliente = interface(IDAStronglyTypedDataTable)
['{1E620AC4-0A78-4423-B993-C73C1C37956E}']
['{0FEC5F43-9506-40C0-AA99-DC678677C6C7}']
{ Property getters and setters }
function GetIDValue: Integer;
procedure SetIDValue(const aValue: Integer);
@ -342,6 +344,8 @@ type
procedure SetID_AGENTEValue(const aValue: Integer);
function GetNUM_COPIASValue: Integer;
procedure SetNUM_COPIASValue(const aValue: Integer);
function GetNUM_CORREOSValue: Integer;
procedure SetNUM_CORREOSValue(const aValue: Integer);
function GetFECHA_VENCIMIENTOValue: DateTime;
procedure SetFECHA_VENCIMIENTOValue(const aValue: DateTime);
@ -381,6 +385,7 @@ type
property REFERENCIA_COMISION: String read GetREFERENCIA_COMISIONValue write SetREFERENCIA_COMISIONValue;
property ID_AGENTE: Integer read GetID_AGENTEValue write SetID_AGENTEValue;
property NUM_COPIAS: Integer read GetNUM_COPIASValue write SetNUM_COPIASValue;
property NUM_CORREOS: Integer read GetNUM_CORREOSValue write SetNUM_CORREOSValue;
property FECHA_VENCIMIENTO: DateTime read GetFECHA_VENCIMIENTOValue write SetFECHA_VENCIMIENTOValue;
end;
@ -457,6 +462,8 @@ type
procedure SetID_AGENTEValue(const aValue: Integer); virtual;
function GetNUM_COPIASValue: Integer; virtual;
procedure SetNUM_COPIASValue(const aValue: Integer); virtual;
function GetNUM_CORREOSValue: Integer; virtual;
procedure SetNUM_CORREOSValue(const aValue: Integer); virtual;
function GetFECHA_VENCIMIENTOValue: DateTime; virtual;
procedure SetFECHA_VENCIMIENTOValue(const aValue: DateTime); virtual;
@ -495,6 +502,7 @@ type
property REFERENCIA_COMISION: String read GetREFERENCIA_COMISIONValue write SetREFERENCIA_COMISIONValue;
property ID_AGENTE: Integer read GetID_AGENTEValue write SetID_AGENTEValue;
property NUM_COPIAS: Integer read GetNUM_COPIASValue write SetNUM_COPIASValue;
property NUM_CORREOS: Integer read GetNUM_CORREOSValue write SetNUM_CORREOSValue;
property FECHA_VENCIMIENTO: DateTime read GetFECHA_VENCIMIENTOValue write SetFECHA_VENCIMIENTOValue;
public
@ -505,7 +513,7 @@ type
{ IFacturasCliente_Detalles }
IFacturasCliente_Detalles = interface(IDAStronglyTypedDataTable)
['{719659FD-6739-411F-A273-E73CE5721675}']
['{2DBD6392-F10F-4A24-B1B2-B7352ADD7B51}']
{ Property getters and setters }
function GetIDValue: Integer;
procedure SetIDValue(const aValue: Integer);
@ -612,7 +620,7 @@ type
{ IFacturasCliente_Detalles_Refresh }
IFacturasCliente_Detalles_Refresh = interface(IDAStronglyTypedDataTable)
['{927E98B8-EC45-41CF-A4D0-33B5B3F70DD9}']
['{20C233CD-3FC4-475D-BA91-AF23A4DC6F21}']
{ Property getters and setters }
function GetIDValue: Integer;
procedure SetIDValue(const aValue: Integer);
@ -719,7 +727,7 @@ type
{ IFacturasCliente_Refresh }
IFacturasCliente_Refresh = interface(IDAStronglyTypedDataTable)
['{7034A9EF-11B0-479C-810E-4635F48B903D}']
['{FC3E4483-F5E9-4AD0-80BC-BB9AE9C1D652}']
{ Property getters and setters }
function GetIDValue: Integer;
procedure SetIDValue(const aValue: Integer);
@ -1328,6 +1336,16 @@ begin
DataTable.Fields[idx_FacturasClienteNUM_COPIAS].AsInteger := aValue;
end;
function TFacturasClienteDataTableRules.GetNUM_CORREOSValue: Integer;
begin
result := DataTable.Fields[idx_FacturasClienteNUM_CORREOS].AsInteger;
end;
procedure TFacturasClienteDataTableRules.SetNUM_CORREOSValue(const aValue: Integer);
begin
DataTable.Fields[idx_FacturasClienteNUM_CORREOS].AsInteger := aValue;
end;
function TFacturasClienteDataTableRules.GetFECHA_VENCIMIENTOValue: DateTime;
begin
result := DataTable.Fields[idx_FacturasClienteFECHA_VENCIMIENTO].AsDateTime;

42
Source/Modulos/Facturas de cliente/Model/schFacturasClienteServer_Intf.pas
View File

@ -9,16 +9,16 @@ const
{ Delta rules ids
Feel free to change them to something more human readable
but make sure they are unique in the context of your application }
RID_DarReferenciaDelta = '{EC8CF18D-9B28-4048-A90B-24F954D0DC5B}';
RID_FacturasClienteDelta = '{9DFFB51A-DD80-4EBA-B1A7-CFDE7A089FA6}';
RID_FacturasCliente_DetallesDelta = '{E2C9BB04-8C40-4E2C-991D-FE75784D4208}';
RID_FacturasCliente_Detalles_RefreshDelta = '{F1B97398-D0F8-40DC-8088-94984892518A}';
RID_FacturasCliente_RefreshDelta = '{75588952-1574-4345-9658-DB10B41E1C75}';
RID_DarReferenciaDelta = '{719E22A7-4321-46B9-A290-B5AAEECCB0E7}';
RID_FacturasClienteDelta = '{41F232DC-7C48-4FE0-A4E2-8D04523A651F}';
RID_FacturasCliente_DetallesDelta = '{2AE6BCD4-8462-49F4-82AA-FA89E30A3C17}';
RID_FacturasCliente_Detalles_RefreshDelta = '{741BF8ED-55D9-4E7B-86D6-22E568D1AEB6}';
RID_FacturasCliente_RefreshDelta = '{84E456C5-AE88-4010-800A-C8316305E702}';
type
{ IDarReferenciaDelta }
IDarReferenciaDelta = interface(IDarReferencia)
['{EC8CF18D-9B28-4048-A90B-24F954D0DC5B}']
['{719E22A7-4321-46B9-A290-B5AAEECCB0E7}']
{ Property getters and setters }
function GetOldVALORValue : String;
@ -47,7 +47,7 @@ type
{ IFacturasClienteDelta }
IFacturasClienteDelta = interface(IFacturasCliente)
['{9DFFB51A-DD80-4EBA-B1A7-CFDE7A089FA6}']
['{41F232DC-7C48-4FE0-A4E2-8D04523A651F}']
{ Property getters and setters }
function GetOldIDValue : Integer;
function GetOldID_EMPRESAValue : Integer;
@ -83,6 +83,7 @@ type
function GetOldREFERENCIA_COMISIONValue : String;
function GetOldID_AGENTEValue : Integer;
function GetOldNUM_COPIASValue : Integer;
function GetOldNUM_CORREOSValue : Integer;
function GetOldFECHA_VENCIMIENTOValue : DateTime;
{ Properties }
@ -120,6 +121,7 @@ type
property OldREFERENCIA_COMISION : String read GetOldREFERENCIA_COMISIONValue;
property OldID_AGENTE : Integer read GetOldID_AGENTEValue;
property OldNUM_COPIAS : Integer read GetOldNUM_COPIASValue;
property OldNUM_CORREOS : Integer read GetOldNUM_CORREOSValue;
property OldFECHA_VENCIMIENTO : DateTime read GetOldFECHA_VENCIMIENTOValue;
end;
@ -230,6 +232,9 @@ type
function GetNUM_COPIASValue: Integer; virtual;
function GetOldNUM_COPIASValue: Integer; virtual;
procedure SetNUM_COPIASValue(const aValue: Integer); virtual;
function GetNUM_CORREOSValue: Integer; virtual;
function GetOldNUM_CORREOSValue: Integer; virtual;
procedure SetNUM_CORREOSValue(const aValue: Integer); virtual;
function GetFECHA_VENCIMIENTOValue: DateTime; virtual;
function GetOldFECHA_VENCIMIENTOValue: DateTime; virtual;
procedure SetFECHA_VENCIMIENTOValue(const aValue: DateTime); virtual;
@ -303,6 +308,8 @@ type
property OldID_AGENTE : Integer read GetOldID_AGENTEValue;
property NUM_COPIAS : Integer read GetNUM_COPIASValue write SetNUM_COPIASValue;
property OldNUM_COPIAS : Integer read GetOldNUM_COPIASValue;
property NUM_CORREOS : Integer read GetNUM_CORREOSValue write SetNUM_CORREOSValue;
property OldNUM_CORREOS : Integer read GetOldNUM_CORREOSValue;
property FECHA_VENCIMIENTO : DateTime read GetFECHA_VENCIMIENTOValue write SetFECHA_VENCIMIENTOValue;
property OldFECHA_VENCIMIENTO : DateTime read GetOldFECHA_VENCIMIENTOValue;
@ -314,7 +321,7 @@ type
{ IFacturasCliente_DetallesDelta }
IFacturasCliente_DetallesDelta = interface(IFacturasCliente_Detalles)
['{E2C9BB04-8C40-4E2C-991D-FE75784D4208}']
['{2AE6BCD4-8462-49F4-82AA-FA89E30A3C17}']
{ Property getters and setters }
function GetOldIDValue : Integer;
function GetOldID_FACTURAValue : Integer;
@ -434,7 +441,7 @@ type
{ IFacturasCliente_Detalles_RefreshDelta }
IFacturasCliente_Detalles_RefreshDelta = interface(IFacturasCliente_Detalles_Refresh)
['{F1B97398-D0F8-40DC-8088-94984892518A}']
['{741BF8ED-55D9-4E7B-86D6-22E568D1AEB6}']
{ Property getters and setters }
function GetOldIDValue : Integer;
function GetOldID_FACTURAValue : Integer;
@ -554,7 +561,7 @@ type
{ IFacturasCliente_RefreshDelta }
IFacturasCliente_RefreshDelta = interface(IFacturasCliente_Refresh)
['{75588952-1574-4345-9658-DB10B41E1C75}']
['{84E456C5-AE88-4010-800A-C8316305E702}']
{ Property getters and setters }
function GetOldIDValue : Integer;
function GetOldID_EMPRESAValue : Integer;
@ -1374,6 +1381,21 @@ begin
BusinessProcessor.CurrentChange.NewValueByName[fld_FacturasClienteNUM_COPIAS] := aValue;
end;
function TFacturasClienteBusinessProcessorRules.GetNUM_CORREOSValue: Integer;
begin
result := BusinessProcessor.CurrentChange.NewValueByName[fld_FacturasClienteNUM_CORREOS];
end;
function TFacturasClienteBusinessProcessorRules.GetOldNUM_CORREOSValue: Integer;
begin
result := BusinessProcessor.CurrentChange.OldValueByName[fld_FacturasClienteNUM_CORREOS];
end;
procedure TFacturasClienteBusinessProcessorRules.SetNUM_CORREOSValue(const aValue: Integer);
begin
BusinessProcessor.CurrentChange.NewValueByName[fld_FacturasClienteNUM_CORREOS] := aValue;
end;
function TFacturasClienteBusinessProcessorRules.GetFECHA_VENCIMIENTOValue: DateTime;
begin
result := BusinessProcessor.CurrentChange.NewValueByName[fld_FacturasClienteFECHA_VENCIMIENTO];

14
Source/Modulos/Facturas de cliente/Reports/uRptFacturasCliente_Server.dfm
View File

@ -1462,4 +1462,18 @@ object RptFacturasCliente: TRptFacturasCliente
Left = 344
Top = 184
end
object frxPDFExport1: TfrxPDFExport
ShowDialog = False
UseFileCache = True
ShowProgress = False
PrintOptimized = True
Outline = True
Author = 'FactuGES'
Subject = 'FactuGES'
Background = False
Creator = 'FactuGES'
HTMLTags = True
Left = 360
Top = 344
end
end

77
Source/Modulos/Facturas de cliente/Reports/uRptFacturasCliente_Server.pas
View File

@ -7,7 +7,7 @@ uses
Dialogs, frxClass, frxDBSet, uDAScriptingProvider,
uDADataTable, uDACDSDataTable, DB, uDAClasses, frxChart, frxGradient,
frxChBox, frxCross, frxOLE, frxBarcode, frxRich, uDABINAdapter, uROTypes,
uDAInterfaces;
uDAInterfaces, FactuGES_Intf, frxExportPDF;
type
TRptFacturasCliente = class(TDataModule)
@ -31,15 +31,19 @@ type
schReport: TDASchema;
DataDictionary: TDADataDictionary;
frxReport: TfrxReport;
frxPDFExport1: TfrxPDFExport;
procedure DataModuleCreate(Sender: TObject);
procedure frxReportGetValue(const VarName: string; var Value: Variant);
private
FConnection: IDAConnection;
FShowLogotipo: Boolean;
//Genera cada uno de los albaranes a imprimir
procedure GenerarFactura(const ID: integer); overload;
procedure _GenerarFactura(const ID: Integer);
public
function GenerarFactura(const AFacturaID: String; const AConLogotipo: Boolean = False): Binary; overload;
function GenerarFactura(const ListaID : TIntegerArray;
const AConLogotipo: Boolean = False): Binary;
function GenerarFacturaEnPDF(const ListaID : TIntegerArray;
const AConLogotipo: Boolean = False): Binary;
end;
implementation
@ -55,26 +59,21 @@ const
{ Dataset names for schReport }
ds_InformeFacturasCliente = 'InformeFacturasCliente';
ds_InformeFacturasCliente_Detalles = 'InformeFacturasCliente_Detalles';
ds_InformeFacturasCliente_Vencimientos = 'InformeFacturasCliente_Vencimientos';
ds_InformeFacturasCliente_Vencimientos = 'InformeFacturasCliente_Vencimientos';
{ TRptFacturasCliente }
procedure TRptFacturasCliente.DataModuleCreate(Sender: TObject);
begin
schReport.ConnectionManager := dmServer.ConnectionManager;
FConnection := dmServer.DarNuevaConexion;
FShowLogotipo := False;
frxReport.EngineOptions.NewSilentMode := simReThrow;
frxReport.EngineOptions.NewSilentMode := simReThrow;
end;
procedure TRptFacturasCliente.frxReportGetValue(const VarName: string; var Value: Variant);
begin
if VarName = 'ShowLogotipo' then
Value := FShowLogotipo;
end;
function TRptFacturasCliente.GenerarFactura(const AFacturaID: String; const AConLogotipo: Boolean = False): Binary;
{function TRptFacturasCliente.GenerarFactura(const AFacturaID: String): Binary;
var
ID_Facturas: TStringList;
i: Integer;
@ -84,7 +83,6 @@ begin
FConnection.BeginTransaction;
try
FShowLogotipo := AConLogotipo;
ID_Facturas := TStringList.Create;
ID_Facturas.CommaText := AFacturaID;
@ -97,9 +95,9 @@ begin
finally
FConnection.RollbackTransaction;
end;
end;
end;}
procedure TRptFacturasCliente.GenerarFactura(const ID: integer);
procedure TRptFacturasCliente._GenerarFactura(const ID: Integer);
var
AStream: TMemoryStream;
dsMaster: IDADataset;
@ -125,6 +123,7 @@ begin
DABINAdapter.WriteDataset(AStream, dsVencimientos, [woRows, woSchema], -1);
DABINAdapter.ReadDataset(AStream, tbl_Vencimientos, TRUE, '', TRUE, TRUE);
frxReport.LoadFromFile(DarRutaInformes + rptFacturaCliente, True);
frxReport.PrepareReport(False);
@ -135,4 +134,52 @@ begin
end;
end;
procedure TRptFacturasCliente.frxReportGetValue(const VarName: string;
var Value: Variant);
begin
if VarName = 'ShowLogotipo' then
Value := FShowLogotipo;
end;
function TRptFacturasCliente.GenerarFactura(
const ListaID: TIntegerArray; const AConLogotipo: Boolean = False): Binary;
var
i: Integer;
begin
FShowLogotipo := AConLogotipo;
Result := Binary.Create;
//FConnection.BeginTransaction; <--- Creo que no va a hacer falta.
try
//Vamos generando todos y cada uno de los presupuestos recibidos
for i := 0 to ListaID.Count - 1 do
_GenerarFactura(ListaID.Items[i]);
frxReport.PreviewPages.SaveToStream(Result);
finally
//FConnection.RollbackTransaction; <--- Creo que no va a hacer falta.
end;
end;
function TRptFacturasCliente.GenerarFacturaEnPDF(
const ListaID: TIntegerArray; const AConLogotipo: Boolean = False): Binary;
var
i: Integer;
begin
FShowLogotipo := AConLogotipo;
Result := Binary.Create;
//FConnection.BeginTransaction; <--- Creo que no va a hacer falta.
try
//Vamos generando todos y cada uno de los presupuestos recibidos
for i := 0 to ListaID.Count - 1 do
_GenerarFactura(ListaID.Items[i]);
frxPDFExport1.Stream := Result;
frxReport.Export(frxPDFExport1)
finally
//FConnection.RollbackTransaction; <--- Creo que no va a hacer falta.
end;
end;
end.

19
Source/Modulos/Facturas de cliente/Servidor/srvFacturasCliente_Impl.dfm
View File

@ -77,7 +77,7 @@ object srvFacturasCliente: TsrvFacturasCliente
'GO_POSTAL, FECHA_ALTA, FECHA_MODIFICACION,'#10' USUARIO, ID_FORMA' +
'_PAGO, RECARGO_EQUIVALENCIA, ID_TIPO_IVA,'#10' IMPORTE_NETO, IMPO' +
'RTE_PORTE, ID_COMISION_LIQUIDADA, REFERENCIA_COMISION,'#10' ID_AG' +
'ENTE, NUM_COPIAS'#10' FROM'#10' V_FACTURAS_CLIENTE'
'ENTE, NUM_COPIAS, NUM_CORREOS'#10' FROM'#10' V_FACTURAS_CLIENTE'
StatementType = stSQL
ColumnMappings = <
item
@ -215,6 +215,10 @@ object srvFacturasCliente: TsrvFacturasCliente
item
DatasetField = 'NUM_COPIAS'
TableField = 'NUM_COPIAS'
end
item
DatasetField = 'NUM_CORREOS'
TableField = 'NUM_CORREOS'
end>
end>
Name = 'FacturasCliente'
@ -571,6 +575,17 @@ object srvFacturasCliente: TsrvFacturasCliente
Lookup = False
LookupCache = False
end
item
Name = 'NUM_CORREOS'
DataType = datInteger
BlobType = dabtUnknown
DisplayWidth = 0
Alignment = taLeftJustify
InPrimaryKey = False
Calculated = False
Lookup = False
LookupCache = False
end
item
Name = 'FECHA_VENCIMIENTO'
DataType = datDateTime
@ -2433,7 +2448,7 @@ object srvFacturasCliente: TsrvFacturasCliente
DataType = datDateTime
BlobType = dabtUnknown
DisplayWidth = 0
DisplayLabel = 'Fecha de las factura'
DisplayLabel = 'Fecha'
Alignment = taLeftJustify
end
item

21
Source/Modulos/Facturas de cliente/Servidor/srvFacturasCliente_Impl.pas
View File

@ -36,7 +36,8 @@ type
protected
{ IsrvFacturasCliente methods }
function GetNextAutoInc(const GeneratorName: String): Integer;
function GenerateReport(const FacturaID: String; const ShowLogotipo: Boolean): Binary;
function GenerarInforme(const ListaID: TIntegerArray; const ShowLogotipo: Boolean): Binary;
function GenerarInformeEnPDF(const ListaID: TIntegerArray; const ShowLogotipo: Boolean): Binary;
end;
implementation
@ -78,13 +79,27 @@ begin
bpFacturasCliente.BusinessRulesID := BIZ_SERVER_FACTURAS_CLIENTE;
end;
function TsrvFacturasCliente.GenerateReport(const FacturaID: String; const ShowLogotipo: Boolean): Binary;
function TsrvFacturasCliente.GenerarInforme(
const ListaID: TIntegerArray; const ShowLogotipo: Boolean): Binary;
var
AReportGenerator : TRptFacturasCliente;
begin
AReportGenerator := TRptFacturasCliente.Create(nil);
try
Result := AReportGenerator.GenerarFactura(FacturaID, ShowLogotipo);
Result := AReportGenerator.GenerarFactura(ListaID, ShowLogotipo);
finally
FreeAndNIL(AReportGenerator);
end;
end;
function TsrvFacturasCliente.GenerarInformeEnPDF(const ListaID: TIntegerArray;
const ShowLogotipo: Boolean): Binary;
var
AReportGenerator : TRptFacturasCliente;
begin
AReportGenerator := TRptFacturasCliente.Create(nil);
try
Result := AReportGenerator.GenerarFacturaEnPDF(ListaID);
finally
FreeAndNIL(AReportGenerator);
end;

3
Source/Modulos/Facturas de cliente/Views/FacturasCliente_view.dpk
View File

@ -101,6 +101,7 @@ contains
uEditorFacturasClienteReport in 'uEditorFacturasClienteReport.pas' {fEditorFacturasClientePreview},
uEditorElegirArticulosFacturaCliente in 'uEditorElegirArticulosFacturaCliente.pas' {fEditorElegirArticulosFacturaCliente: TForm},
uViewElegirArticulosFacturasCliente in 'uViewElegirArticulosFacturasCliente.pas' {frViewElegirArticulosFacturasCliente: TFrame},
uEditorElegirFacturasCliente in 'uEditorElegirFacturasCliente.pas' {fEditorElegirFacturasCliente: TfEditorElegirFacturasCliente};
uEditorElegirFacturasCliente in 'uEditorElegirFacturasCliente.pas' {fEditorElegirFacturasCliente: TfEditorElegirFacturasCliente},
uDialogListaFacturasEnvioEMail in 'uDialogListaFacturasEnvioEMail.pas' {fDialogListaFacturasEnvioEMail};
end.

80
Source/Modulos/Facturas de cliente/Views/uDialogListaFacturasEnvioEMail.dfm Normal file
View File

@ -0,0 +1,80 @@
inherited fDialogListaFacturasEnvioEMail: TfDialogListaFacturasEnvioEMail
Caption = 'Enviar facturas por correo electr'#243'nico'
ClientHeight = 432
ExplicitWidth = 629
ExplicitHeight = 457
PixelsPerInch = 96
TextHeight = 13
inherited pnlBotones: TFlowPanel
Top = 376
ExplicitTop = 376
inherited Button1: TButton
Caption = '&Salir'
end
inherited Button2: TButton
Left = 416
Width = 96
ExplicitLeft = 416
ExplicitWidth = 96
end
end
inherited FlowPanel1: TFlowPanel
Height = 376
ExplicitHeight = 376
inherited lblInstruccion: TLabel
Width = 306
Caption = 'Enviar facturas por correo electr'#243'nico'
Font.Style = [fsBold]
ExplicitWidth = 306
end
inherited Label2: TLabel
Height = 51
Caption =
'Se generar'#225'n correos electr'#243'nicos autom'#225'ticos adjuntando las fac' +
'turas elegidas en formato PDF. S'#243'lo se tendr'#225'n en cuenta los cli' +
'entes que tengan relleno su e-mail administrativo.'
WordWrap = True
ExplicitHeight = 51
end
inherited ListView1: TListView
Top = 121
Height = 232
Columns = <
item
Caption = 'Documento'
MaxWidth = 75
MinWidth = 75
Width = 75
end
item
Caption = 'Destinatario'
MaxWidth = 300
Width = 280
end
item
Caption = 'Direcci'#243'n E-Mail'
MaxWidth = 250
Width = 150
end
item
Caption = 'Estado'
MaxWidth = 200
Width = 100
end>
ExplicitTop = 121
ExplicitHeight = 232
end
end
inherited ActionList1: TActionList
Left = 8
Top = 352
inherited actAceptar: TAction
Caption = '&Generar correos'
OnExecute = actAceptarExecute
OnUpdate = actAceptarUpdate
end
inherited actCancelar: TAction
OnExecute = actCancelarExecute
end
end
end

153
Source/Modulos/Facturas de cliente/Views/uDialogListaFacturasEnvioEMail.pas Normal file
View File

@ -0,0 +1,153 @@
unit uDialogListaFacturasEnvioEMail;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, uDialogBase, ActnList, StdCtrls, ExtCtrls, ComCtrls,
uDialogListaEnvioEMail, uIDialogListaFacturasEnvioEMail, uFacturasClienteController,
uBizFacturasCliente;
type
TfDialogListaFacturasEnvioEMail = class(TfDialogListaEnvioEMail, IDialogListaFacturasEnvioEMail)
procedure actCancelarExecute(Sender: TObject);
procedure actAceptarUpdate(Sender: TObject);
procedure actAceptarExecute(Sender: TObject);
private
FFacturas : IBizFacturaCliente;
FController : IFacturasClienteController;
protected
function GetFacturas: IBizFacturaCliente;
procedure SetFacturas(const Value: IBizFacturaCliente);
procedure RellenarLista;
procedure BorrarLista;
public
constructor Create(AOwner: TComponent); override;
property Facturas: IBizFacturaCliente read GetFacturas write SetFacturas;
end;
implementation
uses
schFacturasClienteClient_Intf, uStringsUtils, cxControls;
{$R *.dfm}
{ TfDialogListaFacturasEnvioEMail }
procedure TfDialogListaFacturasEnvioEMail.actAceptarExecute(Sender: TObject);
var
i : Integer;
begin
ShowHourglassCursor;
Application.ProcessMessages;
try
FFacturas.First;
try
for i := 0 to FFacturas.DataTable.RecordCount - 1 do
begin
if EsCadenaVacia(FFacturas.Cliente.EMAIL_ADMINISTRACION) then
Continue;
if FController.EnviarFacturaPorEMail(FFacturas, True, FFacturas.Cliente.EMAIL_ADMINISTRACION) then
begin
ListView1.Items[i].SubItems[2] := 'Correo generado';
ModalResult := mrOk;
end
else
ListView1.Items[i].SubItems[2] := 'Error al generar correo';
Self.Update;
Application.ProcessMessages;
FFacturas.Next;
end;
Button2.Enabled := False;
finally
ListView1.Items.EndUpdate;
end;
finally
HideHourglassCursor;
end;
Button1.SetFocus;
end;
procedure TfDialogListaFacturasEnvioEMail.actAceptarUpdate(Sender: TObject);
begin
inherited;
(Sender as TAction).Enabled := (ListView1.Items.Count > 0)
end;
procedure TfDialogListaFacturasEnvioEMail.actCancelarExecute(Sender: TObject);
begin
inherited;
ModalResult := mrOk;
end;
procedure TfDialogListaFacturasEnvioEMail.BorrarLista;
begin
ListView1.Items.Clear;
end;
constructor TfDialogListaFacturasEnvioEMail.Create(AOwner: TComponent);
begin
inherited;
ModalResult := mrCancel;
FController := TFacturasClienteController.Create;
end;
function TfDialogListaFacturasEnvioEMail.GetFacturas: IBizFacturaCliente;
begin
Result := FFacturas;
end;
procedure TfDialogListaFacturasEnvioEMail.RellenarLista;
var
i : Integer;
begin
ListView1.Items.BeginUpdate;
ListView1.Items.Clear;
FFacturas.First;
FFacturas.DataTable.DisableControls;
try
for i := 0 to FFacturas.DataTable.RecordCount - 1 do
begin
FController.RecuperarCliente(FFacturas);
FFacturas.Cliente.DataTable.Active := True;
with ListView1.Items.Add do
begin
Caption := FFacturas.REFERENCIA;
SubItems.Add(FFacturas.NOMBRE);
SubItems.Add(FFacturas.Cliente.EMAIL_ADMINISTRACION);
if EsCadenaVacia(FFacturas.Cliente.EMAIL_ADMINISTRACION) then
SubItems.Add('Sin dirección e-mail administrativa')
else
SubItems.Add('')
end;
FFacturas.Next;
end;
finally
FFacturas.DataTable.EnableControls;
ListView1.Items.EndUpdate;
end;
end;
procedure TfDialogListaFacturasEnvioEMail.SetFacturas(
const Value: IBizFacturaCliente);
begin
FFacturas := Value;
if Assigned(FFacturas) then
begin
FFacturas.DataTable.Open;
RellenarLista;
end
else
BorrarLista;
end;
end.

1
Source/Modulos/Facturas de cliente/Views/uEditorElegirArticulosFacturaCliente.dfm
View File

@ -1,5 +1,6 @@
inherited fEditorElegirArticulosFacturaCliente: TfEditorElegirArticulosFacturaCliente
Caption = 'fEditorElegirArticulosFacturaCliente'
ExplicitWidth = 320
ExplicitHeight = 478
PixelsPerInch = 96
TextHeight = 13

1320
Source/Modulos/Facturas de cliente/Views/uEditorFacturaCliente.dfm
View File

File diff suppressed because it is too large Load Diff

19
Source/Modulos/Facturas de cliente/Views/uEditorFacturaCliente.pas
View File

@ -23,6 +23,11 @@ type
frViewDetallesFacturaCliente1: TfrViewDetallesFacturaCliente;
frViewFacturaCliente1: TfrViewFacturaCliente;
frViewTotales1: TfrViewTotales;
actEnviarEMail: TAction;
TBXSubmenuItem2: TTBXSubmenuItem;
TBXItem7: TTBXItem;
TBXSeparatorItem6: TTBXSeparatorItem;
TBXItem33: TTBXItem;
procedure FormShow(Sender: TObject);
procedure frViewClienteFactura1edtlNombrePropertiesEditValueChanged(
Sender: TObject);
@ -41,6 +46,8 @@ type
var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean);
procedure frViewTotales1ePorteEditing(Sender: TObject;
var CanEdit: Boolean);
procedure actEnviarEMailExecute(Sender: TObject);
procedure actEnviarEMailUpdate(Sender: TObject);
private
procedure RecalcularPortePorUnidad;
@ -88,6 +95,18 @@ uses
{
**************************** TfEditorFacturaCliente ****************************
}
procedure TfEditorFacturaCliente.actEnviarEMailExecute(Sender: TObject);
begin
inherited;
FController.GenerarEmailFactura(Factura);
end;
procedure TfEditorFacturaCliente.actEnviarEMailUpdate(Sender: TObject);
begin
inherited;
(Sender as TAction).Enabled := HayDatos;
end;
constructor TfEditorFacturaCliente.Create(AOwner: TComponent);
begin
inherited;

39
Source/Modulos/Facturas de cliente/Views/uEditorFacturasCliente.dfm
View File

@ -38,7 +38,7 @@ inherited fEditorFacturasCliente: TfEditorFacturasCliente
Width = 640
ExplicitWidth = 640
inherited tbxMain: TTBXToolbar
ExplicitWidth = 632
ExplicitWidth = 640
object TBXSubmenuItem2: TTBXSubmenuItem [0]
Caption = 'Nuevo'
DisplayMode = nbdmImageAndText
@ -56,9 +56,18 @@ inherited fEditorFacturasCliente: TfEditorFacturasCliente
inherited TBXItem2: TTBXItem
Visible = False
end
object TBXItem40: TTBXItem [14]
Action = actEnviarEMail
end
end
inherited tbxMenu: TTBXToolbar
ExplicitWidth = 640
object TBXSubmenuItem3: TTBXSubmenuItem [4]
Caption = 'A&cciones'
object TBXItem41: TTBXItem
Action = actEnviarEMail
end
end
end
end
inherited StatusBar: TJvStatusBar
@ -126,9 +135,6 @@ inherited fEditorFacturasCliente: TfEditorFacturasCliente
inherited cxGridViewNUM_COPIAS: TcxGridDBColumn
IsCaptionAssigned = True
end
inherited cxGridViewBASE_IMPONIBLE: TcxGridDBColumn
Visible = True
end
end
end
inherited frViewFiltroBase1: TfrViewFiltroBase
@ -140,18 +146,18 @@ inherited fEditorFacturasCliente: TfEditorFacturasCliente
Width = 640
ExplicitWidth = 640
inherited txtFiltroTodo: TcxTextEdit
ExplicitWidth = 457
Width = 457
ExplicitWidth = 543
Width = 543
end
inherited edtFechaIniFiltro: TcxDateEdit
ExplicitWidth = 239
Width = 239
ExplicitWidth = 263
Width = 263
end
inherited edtFechaFinFiltro: TcxDateEdit
Left = 367
ExplicitLeft = 367
ExplicitWidth = 244
Width = 244
ExplicitWidth = 263
Width = 263
end
end
inherited TBXAlignmentPanel1: TTBXAlignmentPanel
@ -224,6 +230,12 @@ inherited fEditorFacturasCliente: TfEditorFacturasCliente
ImageIndex = 24
OnExecute = actNuevoAbonoExecute
end
object actEnviarEMail: TAction
Category = 'Acciones'
Caption = 'Enviar por e-mail...'
OnExecute = actEnviarEMailExecute
OnUpdate = actEnviarEMailUpdate
end
end
inherited SmallImages: TPngImageList [5]
PngImages = <
@ -1777,11 +1789,8 @@ inherited fEditorFacturasCliente: TfEditorFacturasCliente
object N4: TMenuItem [8]
Caption = '-'
end
object Cambiarlasituacin1: TMenuItem [9]
Caption = 'Cambiar la situaci'#243'n'
Hint =
'Cambiar la situaci'#243'n de la factura seleccionada (Pendiente/Pagad' +
'a)'
object Enviarporemail1: TMenuItem [9]
Action = actEnviarEMail
end
end
object JsNuevaFacturaDialog: TJSDialog

44
Source/Modulos/Facturas de cliente/Views/uEditorFacturasCliente.pas
View File

@ -18,7 +18,6 @@ type
TfEditorFacturasCliente = class(TfEditorGridBase, IEditorFacturasCliente)
frViewFacturasCliente1: TfrViewFacturasCliente;
Cambiarlasituacin1: TMenuItem;
N4: TMenuItem;
JsNuevaFacturaDialog: TJSDialog;
JsListaFacturasGeneradas: TJSDialog;
@ -31,10 +30,17 @@ type
actNuevoAbono: TAction;
JsNuevoAbonoDialog: TJSDialog;
JsListaFacturasNoEliminadas: TJSDialog;
actEnviarEMail: TAction;
TBXItem40: TTBXItem;
TBXSubmenuItem3: TTBXSubmenuItem;
TBXItem41: TTBXItem;
Enviarporemail1: TMenuItem;
procedure FormShow(Sender: TObject);
procedure actEliminarUpdate(Sender: TObject);
procedure actNuevaFacturaExecute(Sender: TObject);
procedure actNuevoAbonoExecute(Sender: TObject);
procedure actEnviarEMailExecute(Sender: TObject);
procedure actEnviarEMailUpdate(Sender: TObject);
private
FFacturas: IBizFacturaCliente;
FController : IFacturasClienteController;
@ -64,7 +70,8 @@ implementation
uses
uDataModuleFacturasCliente, uDataModuleUsuarios, uAlbaranesClienteController,
uPedidosClienteController, uBizAlbaranesCliente, uBizPedidosCliente,
uEditorBase, uGenerarFacturasCliAlbCliUtils, uGridUtils, uDBSelectionListUtils;
uEditorBase, uGenerarFacturasCliAlbCliUtils, uGridUtils, uDBSelectionListUtils,
cxControls;
{$R *.dfm}
@ -78,6 +85,39 @@ begin
(Sender as TAction).Enabled := (FFacturas.SITUACION = 'PENDIENTE');
end;
procedure TfEditorFacturasCliente.actEnviarEMailExecute(Sender: TObject);
var
AFacturas : IBizFacturaCliente;
begin
inherited;
if ViewGrid.NumSeleccionados = 1 then
FController.GenerarEmailFactura(Facturas)
else begin
ShowHourglassCursor;
try
SeleccionarFilasDesdeGrid(ViewGrid._FocusedView, (Facturas as ISeleccionable).SelectedRecords);
AFacturas := (Controller as IFacturasClienteController).ExtraerSeleccionados(Facturas, ViewGrid) as IBizFacturaCliente;
if Assigned(AFacturas) then
FController.EnviarEmailFacturas(AFacturas);
finally
AFacturas := NIL;
HideHourglassCursor;
end;
end;
end;
procedure TfEditorFacturasCliente.actEnviarEMailUpdate(Sender: TObject);
begin
inherited;
if HayDatos and Assigned(ViewGrid) then
(Sender as TAction).Enabled := ViewGrid.esSeleccionCeldaDatos
and (ViewGrid.NumSeleccionados > 0)
else
(Sender as TAction).Enabled := False;
end;
procedure TfEditorFacturasCliente.actNuevaFacturaExecute(Sender: TObject);
begin
actNuevo.Execute;

4
Source/Modulos/Facturas de cliente/Views/uFacturasClienteViewRegister.pas
View File

@ -10,7 +10,7 @@ implementation
uses
uEditorRegistryUtils, uEditorFacturasCliente, uEditorFacturaCliente,
uEditorFacturasClienteReport, uEditorElegirArticulosFacturaCliente,
uEditorElegirFacturasCliente;
uEditorElegirFacturasCliente, uDialogListaFacturasEnvioEMail;
procedure RegisterViews;
begin
@ -19,6 +19,7 @@ begin
EditorRegistry.RegisterClass(TfEditorElegirArticulosFacturaCliente, 'EditorElegirArticulosFacturaCliente');
EditorRegistry.RegisterClass(TfEditorElegirFacturasCliente, 'EditorElegirFacturasCliente');
EditorRegistry.RegisterClass(TfEditorFacturasClientePreview, 'EditorFacturasClientePreview');
EditorRegistry.RegisterClass(TfDialogListaFacturasEnvioEMail, 'DialogListaFacturasEnvioEMail');
end;
procedure UnregisterViews;
@ -28,6 +29,7 @@ begin
EditorRegistry.UnRegisterClass(TfEditorElegirArticulosFacturaCliente);
EditorRegistry.UnRegisterClass(TfEditorElegirFacturasCliente);
EditorRegistry.UnRegisterClass(TfEditorFacturasClientePreview);
EditorRegistry.UnRegisterClass(TfDialogListaFacturasEnvioEMail);
end;
end.

139
Source/Modulos/Facturas de cliente/Views/uViewFacturasCliente.dfm
View File

@ -23,13 +23,30 @@ inherited frViewFacturasCliente: TfrViewFacturasCliente
OptionsView.GroupFooters = gfAlwaysVisible
object cxGridViewNUM_COPIAS: TcxGridDBColumn
DataBinding.FieldName = 'NUM_COPIAS'
PropertiesClassName = 'TcxTextEditProperties'
Properties.Alignment.Horz = taCenter
OnCustomDrawCell = cxGridViewNUM_COPIASCustomDrawCell
MinWidth = 30
Options.HorzSizing = False
BestFitMaxWidth = 20
MinWidth = 25
Options.Moving = False
Options.ShowCaption = False
VisibleForCustomization = False
Width = 30
Width = 25
OnCustomDrawHeader = cxGridViewNUM_COPIASCustomDrawHeader
IsCaptionAssigned = True
end
object cxGridViewNUM_CORREOS: TcxGridDBColumn
DataBinding.FieldName = 'NUM_CORREOS'
PropertiesClassName = 'TcxTextEditProperties'
Properties.Alignment.Horz = taCenter
BestFitMaxWidth = 20
MinWidth = 25
Options.Moving = False
Options.ShowCaption = False
VisibleForCustomization = False
Width = 25
OnCustomDrawHeader = cxGridViewNUM_CORREOSCustomDrawHeader
end
object cxGridViewTIPO: TcxGridDBColumn
DataBinding.FieldName = 'TIPO'
PropertiesClassName = 'TcxImageComboBoxProperties'
@ -50,22 +67,26 @@ inherited frViewFacturasCliente: TfrViewFacturasCliente
object cxGridViewREFERENCIA: TcxGridDBColumn
DataBinding.FieldName = 'REFERENCIA'
PropertiesClassName = 'TcxTextEditProperties'
BestFitMaxWidth = 70
SortIndex = 0
SortOrder = soDescending
Width = 69
end
object cxGridViewSITUACION: TcxGridDBColumn
DataBinding.FieldName = 'SITUACION'
BestFitMaxWidth = 70
Width = 32
end
object cxGridViewFECHA_FACTURA: TcxGridDBColumn
DataBinding.FieldName = 'FECHA_FACTURA'
PropertiesClassName = 'TcxDateEditProperties'
BestFitMaxWidth = 70
Width = 28
end
object cxGridViewNIF_CIF: TcxGridDBColumn
DataBinding.FieldName = 'NIF_CIF'
Visible = False
BestFitMaxWidth = 70
end
object cxGridViewNOMBRE: TcxGridDBColumn
DataBinding.FieldName = 'NOMBRE'
@ -78,6 +99,7 @@ inherited frViewFacturasCliente: TfrViewFacturasCliente
object cxGridViewCODIGO_POSTAL: TcxGridDBColumn
DataBinding.FieldName = 'CODIGO_POSTAL'
Visible = False
BestFitMaxWidth = 70
end
object cxGridViewPOBLACION: TcxGridDBColumn
DataBinding.FieldName = 'POBLACION'
@ -86,10 +108,12 @@ inherited frViewFacturasCliente: TfrViewFacturasCliente
object cxGridViewPROVINCIA: TcxGridDBColumn
DataBinding.FieldName = 'PROVINCIA'
Visible = False
BestFitMaxWidth = 70
end
object cxGridViewBASE_IMPONIBLE: TcxGridDBColumn
DataBinding.FieldName = 'BASE_IMPONIBLE'
PropertiesClassName = 'TcxCurrencyEditProperties'
Properties.Alignment.Horz = taRightJustify
Visible = False
FooterAlignmentHorz = taRightJustify
HeaderAlignmentHorz = taRightJustify
@ -97,12 +121,14 @@ inherited frViewFacturasCliente: TfrViewFacturasCliente
object cxGridViewDESCUENTO: TcxGridDBColumn
DataBinding.FieldName = 'DESCUENTO'
Visible = False
BestFitMaxWidth = 30
FooterAlignmentHorz = taRightJustify
HeaderAlignmentHorz = taRightJustify
end
object cxGridViewIMPORTE_DESCUENTO: TcxGridDBColumn
DataBinding.FieldName = 'IMPORTE_DESCUENTO'
PropertiesClassName = 'TcxCurrencyEditProperties'
Properties.Alignment.Horz = taRightJustify
Visible = False
FooterAlignmentHorz = taRightJustify
HeaderAlignmentHorz = taRightJustify
@ -110,12 +136,14 @@ inherited frViewFacturasCliente: TfrViewFacturasCliente
object cxGridViewIVA: TcxGridDBColumn
DataBinding.FieldName = 'IVA'
Visible = False
BestFitMaxWidth = 30
FooterAlignmentHorz = taRightJustify
HeaderAlignmentHorz = taRightJustify
end
object cxGridViewIMPORTE_IVA: TcxGridDBColumn
DataBinding.FieldName = 'IMPORTE_IVA'
PropertiesClassName = 'TcxCurrencyEditProperties'
Properties.Alignment.Horz = taRightJustify
Visible = False
FooterAlignmentHorz = taRightJustify
HeaderAlignmentHorz = taRightJustify
@ -157,18 +185,18 @@ inherited frViewFacturasCliente: TfrViewFacturasCliente
Width = 531
ExplicitWidth = 531
inherited txtFiltroTodo: TcxTextEdit
ExplicitWidth = 273
Width = 273
ExplicitWidth = 434
Width = 434
end
inherited edtFechaIniFiltro: TcxDateEdit
ExplicitWidth = 121
Width = 121
ExplicitWidth = 202
Width = 202
end
inherited edtFechaFinFiltro: TcxDateEdit
Left = 248
ExplicitLeft = 248
ExplicitWidth = 244
Width = 244
Left = 306
ExplicitLeft = 306
ExplicitWidth = 215
Width = 215
end
end
inherited TBXAlignmentPanel1: TTBXAlignmentPanel
@ -241,6 +269,95 @@ inherited frViewFacturasCliente: TfrViewFacturasCliente
OnUpdate = actProvinciaUpdate
end
end
inherited PngImageList10: TPngImageList
ShareImages = True
PngImages = <
item
PngImage.Data = {
89504E470D0A1A0A0000000D4948445200000010000000100804000000B5FA37
EA000000097048597300000B1300000B1301009A9C180000031B694343505068
6F746F73686F70204943432070726F66696C65000078DA6360609EE0E8E2E4CA
24C0C050505452E41EE418191119A5C07E9E818D819981818181812131B9B8C0
3120C087818181212F3F2F9501153032307CBBC6C0C8C0C0C07059D7D1C5C995
8134C09A5C5054C2C0C070808181C12825B538998181E10B0303437A79494109
0303630C03038348527641090303630103038348764890330303630B0303134F
496A450903030383737E416551667A468982A1A5A5A582634A7E52AA42706571
496A6EB182675E727E51417E5162496A0A030303D40E060606065E97FC1205F7
C4CC3C05435355062A8388C82805080B113E083104482E2D2A83072503830083
16831F4325C32A86078CD28C518CF3189F32193235305D62D6606E64BECB62C3
328F9599359BF52A9B13DB267615F6991C021C9D9CAC9CCD5CCC5C6DDCDCDC13
79A47896F21AF31EE20BE67BC65F2D2024B05AD04DF09150A3B0A2F061917451
5ED1AD6271E29CE25B25522485258F4A5548EB4A3F9199231B2A27287756BE47
C1479157F182D214E528152595D7AA5BD51AD5FD346435DE6AEED39AA89DAA63
AD2BA4FB4AEF88FE7C831AC328234B6349E3DF26F74C0F9BAD30EFB7A8B04CB4
F2B1B6B051B515B163B1FB6AFFDCE1B6E305A763CE7B5DB6BAAE775BE9BED463
91E742AF05DE0B7D16FB2EF35BE5BF3E606BE0DEA063C1E7436E853E0BFB12C1
142918A5146D1CE3161B159717DF92303B7173D2D9E4E7A94C6972E936195199
5559B3B2F7E4DCCB63CA572FF0292C2E9A5D7CB8E46D9944B94B4561E5BCAAB3
D57F6BF5EAE2EB27351C6BFCDD6CD092DE3AAFED7A8760A777577BF7E15E863E
FBFEBA09FB26FE9FEC38A575EA89E9BC338267CE9AF5688ED6DC9279FB16702D
0C5BB478F1C7A50ECB262C7FB8D27855EBEA9B6B75D735ADBFB9D16053C7E607
5BADB64DDDFE61A7EFAE557B38F6A6EF3B7E40FD60E7A1D747FC8E6E3E2E7EA2
F6E493D3DE67B69C933DDF7EE1D3A5B8CBA7AE5A5C5B7643F466EBADAF77D2EF
DEBCEFF3E0C023D3C7AB9F2A3E9BF942F065D76BE637756F7FBE2FFDF0E953C1
E7775FF3BEBDFB91FFF3C3EFE23FDFFE55FDFF0F002E0C1D8BA03C0931000001
2D4944415478DA63FCCF801F3092AC20EFFFFF870C070A0EA82CF88F4D41EEFF
7C063E20BD80E1F0C1CD0E680AEAFEBF67C8679060F8C8F0986119C3858F8704
501494FECF60A867980B94FECCB08A61FBC7A2050105480A4AFE973188319C67
E863286238C2B099C139B06203921B20D2207082A10B688630C31F8660C7E803
700515FF8BC00A5E333C6778C6F0936111832EC3A58FEB106EE8FAFF8521186C
C21786870C6B80D2AF800EDDC28864851BC33E86FF0C3A0C3F18B603A59F30FC
62F8C0B019A2C055E08F81C8FEC90C8C0C5719B6315C6330014BFF072A809A00
22BC13A4E67B336803832891419CE137D01D5C0C2F034F6D802B6060F049F837
4190DF111840BF19FE7FFC9170062809F5268838C8A8CEC8CE129DF5A5E5F79F
1FA97F375FFA0112C51A1798000002C5780121B7DDC80000000049454E44AE42
6082}
Name = 'PngImage0'
Background = clWindow
end
item
PngImage.Data = {
89504E470D0A1A0A0000000D4948445200000010000000100804000000B5FA37
EA000000097048597300000B1300000B1301009A9C180000031B694343505068
6F746F73686F70204943432070726F66696C65000078DA6360609EE0E8E2E4CA
24C0C050505452E41EE418191119A5C07E9E818D819981818181812131B9B8C0
3120C087818181212F3F2F9501153032307CBBC6C0C8C0C0C07059D7D1C5C995
8134C09A5C5054C2C0C070808181C12825B538998181E10B0303437A79494109
0303630C03038348527641090303630103038348764890330303630B0303134F
496A450903030383737E416551667A468982A1A5A5A582634A7E52AA42706571
496A6EB182675E727E51417E5162496A0A030303D40E060606065E97FC1205F7
C4CC3C05435355062A8388C82805080B113E083104482E2D2A83072503830083
16831F4325C32A86078CD28C518CF3189F32193235305D62D6606E64BECB62C3
328F9599359BF52A9B13DB267615F6991C021C9D9CAC9CCD5CCC5C6DDCDCDC13
79A47896F21AF31EE20BE67BC65F2D2024B05AD04DF09150A3B0A2F061917451
5ED1AD6271E29CE25B25522485258F4A5548EB4A3F9199231B2A27287756BE47
C1479157F182D214E528152595D7AA5BD51AD5FD346435DE6AEED39AA89DAA63
AD2BA4FB4AEF88FE7C831AC328234B6349E3DF26F74C0F9BAD30EFB7A8B04CB4
F2B1B6B051B515B163B1FB6AFFDCE1B6E305A763CE7B5DB6BAAE775BE9BED463
91E742AF05DE0B7D16FB2EF35BE5BF3E606BE0DEA063C1E7436E853E0BFB12C1
142918A5146D1CE3161B159717DF92303B7173D2D9E4E7A94C6972E936195199
5559B3B2F7E4DCCB63CA572FF0292C2E9A5D7CB8E46D9944B94B4561E5BCAAB3
D57F6BF5EAE2EB27351C6BFCDD6CD092DE3AAFED7A8760A777577BF7E15E863E
FBFEBA09FB26FE9FEC38A575EA89E9BC338267CE9AF5688ED6DC9279FB16702D
0C5BB478F1C7A50ECB262C7FB8D27855EBEA9B6B75D735ADBFB9D16053C7E607
5BADB64DDDFE61A7EFAE557B38F6A6EF3B7E40FD60E7A1D747FC8E6E3E2E7EA2
F6E493D3DE67B69C933DDF7EE1D3A5B8CBA7AE5A5C5B7643F466EBADAF77D2EF
DEBCEFF3E0C023D3C7AB9F2A3E9BF942F065D76BE637756F7FBE2FFDF0E953C1
E7775FF3BEBDFB91FFF3C3EFE23FDFFE55FDFF0F002E0C1D8BA03C0931000000
C14944415478DABDD13F0BC14118C0F1EF6D06B1B1FEDE80FABD082619E49D78
0B769B49190C8A41C9885226857E06938588FC1D0CFE0E8F27830E6592ABE7BA
EE3EF7DC3D7746F8DECCDF404D2E0886B3C64D7B34D2C60215199320A4CB270E
ACE952626483A2387494843932D311E499D8A02071A63488E9414D1C069499DB
2027294DDC66C79E2D11FA9A656D83AC44A9E3E2D75B780C59D27B05190912C0
A7BB17CCD928FB00AD4781272DCFC78AABCEBD00F37C98F787FB0049B7EAFDF6
2FEEC02251018239FFBF0000000049454E44AE426082}
Name = 'PngImage1'
Background = clWindow
end>
Left = 264
Top = 168
Bitmap = {}
end
inherited dxPrintStyleManager1: TdxPrintStyleManager
inherited dxPrintStyleManager1Style1: TdxPSPrintStyle
BuiltInStyle = True

57
Source/Modulos/Facturas de cliente/Views/uViewFacturasCliente.pas
View File

@ -56,6 +56,7 @@ type
TBXSeparatorItem2: TTBXSeparatorItem;
cxGridViewTIPO: TcxGridDBColumn;
cxGridViewNUM_COPIAS: TcxGridDBColumn;
cxGridViewNUM_CORREOS: TcxGridDBColumn;
procedure cxGridViewStylesGetContentStyle(Sender: TcxCustomGridTableView;
ARecord: TcxCustomGridRecord; AItem: TcxCustomGridTableItem;
out AStyle: TcxStyle);
@ -67,6 +68,12 @@ type
procedure cxGridViewNUM_COPIASCustomDrawCell(Sender: TcxCustomGridTableView;
ACanvas: TcxCanvas; AViewInfo: TcxGridTableDataCellViewInfo;
var ADone: Boolean);
procedure cxGridViewNUM_COPIASCustomDrawHeader(Sender: TcxGridTableView;
ACanvas: TcxCanvas; AViewInfo: TcxGridColumnHeaderViewInfo;
var ADone: Boolean);
procedure cxGridViewNUM_CORREOSCustomDrawHeader(Sender: TcxGridTableView;
ACanvas: TcxCanvas; AViewInfo: TcxGridColumnHeaderViewInfo;
var ADone: Boolean);
private
//Filtros relativos a la vista
@ -190,18 +197,60 @@ end;
procedure TfrViewFacturasCliente.cxGridViewNUM_COPIASCustomDrawCell(
Sender: TcxCustomGridTableView; ACanvas: TcxCanvas;
AViewInfo: TcxGridTableDataCellViewInfo; var ADone: Boolean);
var
R : TRect;
{var
R : TRect;}
begin
inherited;
if (AViewInfo.GridRecord.DisplayTexts[cxGridViewNUM_COPIAS.Index] <> '') then
// inherited;
{if (AViewInfo.GridRecord.DisplayTexts[cxGridViewNUM_COPIAS.Index] <> '') then
begin
R := AViewInfo.ContentBounds;
ACanvas.FillRect(R);
ACanvas.DrawImage(PngImageList, R.Left, R.Top, 4);
ACanvas.DrawTexT(AViewInfo.GridRecord.DisplayTexts[cxGridViewNUM_COPIAS.Index], R, cxAlignCenter or cxAlignVCenter);
ADone := True;
end;}
end;
procedure TfrViewFacturasCliente.cxGridViewNUM_COPIASCustomDrawHeader(
Sender: TcxGridTableView; ACanvas: TcxCanvas;
AViewInfo: TcxGridColumnHeaderViewInfo; var ADone: Boolean);
var
R : TRect;
begin
inherited;
with AViewInfo do
begin
LookAndFeelPainter.DrawHeader(ACanvas, Bounds, TextAreaBounds, Neighbors,
Borders, ButtonState, AlignmentHorz, AlignmentVert, MultiLine,
False, '', Params.Font, Params.TextColor, Params.Color);
R := AViewInfo.ContentBounds;
ACanvas.FillRect(R);
ACanvas.DrawImage(PngImageList10, R.Left + 2, R.Top, 0);
end;
ADone := True;
end;
procedure TfrViewFacturasCliente.cxGridViewNUM_CORREOSCustomDrawHeader(
Sender: TcxGridTableView; ACanvas: TcxCanvas;
AViewInfo: TcxGridColumnHeaderViewInfo; var ADone: Boolean);
var
R : TRect;
begin
inherited;
with AViewInfo do
begin
LookAndFeelPainter.DrawHeader(ACanvas, Bounds, TextAreaBounds, Neighbors,
Borders, ButtonState, AlignmentHorz, AlignmentVert, MultiLine,
False, '', Params.Font, Params.TextColor, Params.Color);
R := AViewInfo.ContentBounds;
ACanvas.FillRect(R);
ACanvas.DrawImage(PngImageList10, R.Left + 2, R.Top, 1);
end;
ADone := True;
end;
procedure TfrViewFacturasCliente.cxGridViewStylesGetContentStyle(

4
Source/Modulos/Formas de pago/Model/uBizFormasPagoPlazos.pas
View File

@ -32,8 +32,8 @@ uses
Dialogs, DB;
procedure TBizFormasPagoPlazos.BeforeInsert(Sender: TDADataTable);
var
AMasterTable : TDADataTable;
{var
AMasterTable : TDADataTable;}
begin
inherited;
//En este caso no se debe hacer porque falla el maestro-detalle al añadir los plazos de una nueva forma de pago desde una factura

77
Source/Modulos/Registro de correos/Data/uDataModuleRegistroCorreos.dfm Normal file
View File

@ -0,0 +1,77 @@
object DataModuleRegistroCorreos: TDataModuleRegistroCorreos
OldCreateOrder = True
OnCreate = DAClientDataModuleCreate
RemoteService = RORemoteService
Adapter = DABinAdapter
SchemaCall.MethodName = 'GetSchemaAsXML'
SchemaCall.Params = <
item
Name = 'Result'
ParamType = fResult
DataType = rtString
end>
Height = 414
Width = 518
object RORemoteService: TRORemoteService
ServiceName = 'srvRegistroCorreos'
Message = ROBinMessage1
Channel = ROWinInetHTTPChannel1
Left = 48
Top = 24
end
object DABinAdapter: TDABINAdapter
Left = 48
Top = 80
end
object DADesigntimeCall1: TDADesigntimeCall
RemoteRequest.MethodName = 'Login'
RemoteRequest.Params = <
item
Name = 'Result'
ParamType = fResult
DataType = rtBoolean
end
item
Name = 'User'
ParamType = fIn
DataType = rtString
Value = 'Administrador'
end
item
Name = 'Password'
ParamType = fIn
DataType = rtString
Value = '1'
end
item
Name = 'LoginInfo'
ParamType = fOut
DataType = rtUserDefined
UserClassName = 'TRdxLoginInfo'
end>
RemoteService = LoginRemoteService
Left = 48
Top = 160
end
object LoginRemoteService: TRORemoteService
ServiceName = 'srvLogin'
Message = ROBinMessage1
Channel = ROWinInetHTTPChannel1
Left = 48
Top = 216
end
object ROWinInetHTTPChannel1: TROWinInetHTTPChannel
ServerLocators = <>
DispatchOptions = []
ProbeServers = False
ProbeFrequency = 60000
UserAgent = 'RemObjects SDK'
TargetURL = 'http://localhost:8099/bin'
Left = 48
Top = 272
end
object ROBinMessage1: TROBinMessage
Left = 48
Top = 324
end
end

91
Source/Modulos/Registro de correos/Data/uDataModuleRegistroCorreos.pas Normal file
View File

@ -0,0 +1,91 @@
unit uDataModuleRegistroCorreos;
interface
uses
SysUtils, Classes, DB, uDAClientDataModule, uDADataTable, uDABINAdapter,
uDAScriptingProvider, uDACDSDataTable, uROWinInetHttpChannel, uROTypes,
uROServiceComponent, uRORemoteService, uROClient, uROBinMessage,
uDADesigntimeCall, uIntegerListUtils;
type
TDataModuleRegistroCorreos = class(TDAClientDataModule)
RORemoteService: TRORemoteService;
DABinAdapter: TDABINAdapter;
DADesigntimeCall1: TDADesigntimeCall;
LoginRemoteService: TRORemoteService;
ROWinInetHTTPChannel1: TROWinInetHTTPChannel;
ROBinMessage1: TROBinMessage;
procedure DAClientDataModuleCreate(Sender: TObject);
public
function AnadirMarcaEnvioCorreo(const Tabla: String; IDTabla: Integer): Boolean; overload;
function AnadirMarcaEnvioCorreo(const Tabla: String; IDsTabla: TIntegerList): Boolean; overload;
end;
function AnadirMarcaEnvioCorreo(const Tabla: String; IDTabla: Integer): Boolean; overload;
function AnadirMarcaEnvioCorreo(const Tabla: String; IDsTabla: TIntegerList): Boolean; overload;
implementation
{$R *.DFM}
uses
FactuGES_Intf, uDataModuleConexion, uDataTableUtils, cxControls, uDAInterfaces,
Dialogs;
function AnadirMarcaEnvioCorreo(const Tabla: String; IDTabla: Integer): Boolean;
var
ADM : TDataModuleRegistroCorreos;
begin
ADM := TDataModuleRegistroCorreos.Create(nil);
try
Result := ADM.AnadirMarcaEnvioCorreo(Tabla, IDTabla);
finally
FreeANDNIL(ADM);
end;
end;
function AnadirMarcaEnvioCorreo(const Tabla: String; IDsTabla: TIntegerList): Boolean;
var
ADM : TDataModuleRegistroCorreos;
begin
ADM := TDataModuleRegistroCorreos.Create(nil);
try
ADM.AnadirMarcaEnvioCorreo(Tabla, IDsTabla);
finally
FreeANDNIL(ADM);
end;
end;
{ TdmImpresiones }
function TDataModuleRegistroCorreos.AnadirMarcaEnvioCorreo(const Tabla: String;
IDTabla: Integer): Boolean;
var
AList : TIntegerList;
begin
AList := TIntegerList.Create;
try
AList.Add(IDTabla);
Result := Self.AnadirMarcaEnvioCorreo(Tabla, AList);
finally
FreeANDNIL(AList)
end;
end;
function TDataModuleRegistroCorreos.AnadirMarcaEnvioCorreo(const Tabla: String;
IDsTabla: TIntegerList): Boolean;
begin
Result := (RORemoteService as IsrvRegistroCorreos).AnadirMarcaEnvio(Tabla, IDsTabla.ToIntegerArray);
end;
procedure TDataModuleRegistroCorreos.DAClientDataModuleCreate(Sender: TObject);
begin
RORemoteService.Channel := dmConexion.Channel;
RORemoteService.Message := dmConexion.Message;
end;
end.

49
Source/Modulos/Registro de correos/Servidor/srvRegistroCorreos_Impl.dfm Normal file
View File

@ -0,0 +1,49 @@
object srvRegistroCorreos: TsrvRegistroCorreos
OldCreateOrder = True
RequiresSession = True
SessionManager = dmServer.SessionManager
AcquireConnection = True
ServiceSchema = schRegistroCorreo
ServiceAdapter = DABINAdapter
Height = 176
Width = 358
object schRegistroCorreo: TDASchema
ConnectionManager = dmServer.ConnectionManager
Datasets = <>
Commands = <
item
Params = <
item
Name = 'TABLA'
DataType = datString
Size = 50
BlobType = dabtUnknown
Value = ''
ParamType = daptInput
end
item
Name = 'IDTABLA'
BlobType = dabtUnknown
Value = ''
ParamType = daptUnknown
end>
Statements = <
item
Connection = 'IBX'
TargetTable = 'REGISTRO_CORREOS'
SQL = 'execute procedure PRO_ANADIR_MARCA_ENVIO_CORREO :TABLA, :IDTABLA'
StatementType = stSQL
ColumnMappings = <>
end>
Name = 'AnadirMarcaEnvio'
end>
RelationShips = <>
UpdateRules = <>
Left = 48
Top = 24
end
object DABINAdapter: TDABINAdapter
Left = 48
Top = 90
end
end

86
Source/Modulos/Registro de correos/Servidor/srvRegistroCorreos_Impl.pas Normal file
View File

@ -0,0 +1,86 @@
unit srvRegistroCorreos_Impl;
{----------------------------------------------------------------------------}
{ This unit was automatically generated by the RemObjects SDK after reading }
{ the RODL file associated with this project . }
{ }
{ This is where you are supposed to code the implementation of your objects. }
{----------------------------------------------------------------------------}
interface
uses
{vcl:} Classes, SysUtils,
{RemObjects:} uROClientIntf, uROTypes, uROServer, uROServerIntf, uROSessions,
{Ancestor Implementation:} DARemoteService_Impl,
{Used RODLs:} DataAbstract_Intf,
{Generated:} FactuGES_Intf, uDADataTable, uDABINAdapter, uDAClasses,
uDAScriptingProvider, uDABusinessProcessor;
type
{ TsrvRegistroCorreos }
TsrvRegistroCorreos = class(TDARemoteService, IsrvRegistroCorreos)
DABINAdapter: TDABINAdapter;
schRegistroCorreo: TDASchema;
private
protected
{ IsrvRegistroCorreos methods }
function AnadirMarcaEnvio(const NombreTabla: String; const IdsTabla: TIntegerArray): Boolean;
end;
implementation
{$R *.dfm}
uses
{Generated:} FactuGES_Invk, uDataModuleServer, uDatabaseUtils, uDAInterfaces,
uROClasses;
procedure Create_srvRegistroCorreos(out anInstance : IUnknown);
begin
anInstance := TsrvRegistroCorreos.Create(NIL);
end;
{ srvRegistroCorreos }
function TsrvRegistroCorreos.AnadirMarcaEnvio(const NombreTabla: String; const IdsTabla: TIntegerArray): Boolean;
var
ASchema : TDASchema;
AConn : IDAConnection;
dsCommand: IDASQLCommand;
i: Integer;
begin
Result := False;
ASchema := schRegistroCorreo;
AConn := dmServer.ConnectionManager.NewConnection(dmServer.ConnectionManager.GetDefaultConnectionName);
try
try
//Vamos generando todas y cada una de las marcas de impresion
for i := 0 to IdsTabla.Count - 1 do
begin
dsCommand := ASchema.NewCommand(AConn, 'AnadirMarcaEnvio');
with dsCommand do
begin
ParamByName('TABLA').AsString := NombreTabla;
ParamByName('IDTABLA').AsInteger := IdsTabla.Items[i];
end;
dsCommand.Execute;
end;
AConn.CommitTransaction;
Result := True;
except
RaiseError('Error al añadir una nueva marca de envio ' + NombreTabla + ' en tablas');
AConn.RollbackTransaction;
end;
finally
dsCommand := NIL;
ASchema := NIL;
end;
end;
initialization
TROClassFactory.Create('srvRegistroCorreos', Create_srvRegistroCorreos, TsrvRegistroCorreos_Invoker);
finalization
end.

36
Source/Servicios/FactuGES.RODL
View File

@ -126,11 +126,21 @@
</Parameter>
</Parameters>
</Operation>
<Operation Name="GenerateReport" UID="{8410D113-BEA9-4A0A-B5C7-BE0AFF66DA02}">
<Operation Name="GenerarInforme" UID="{8410D113-BEA9-4A0A-B5C7-BE0AFF66DA02}">
<Parameters>
<Parameter Name="Result" DataType="Binary" Flag="Result">
</Parameter>
<Parameter Name="FacturaID" DataType="String" Flag="In" >
<Parameter Name="ListaID" DataType="TIntegerArray" Flag="In" >
</Parameter>
<Parameter Name="ShowLogotipo" DataType="Boolean" Flag="In" >
</Parameter>
</Parameters>
</Operation>
<Operation Name="GenerarInformeEnPDF" UID="{D2C4E6D0-9D90-4C35-9C92-B9139493B849}">
<Parameters>
<Parameter Name="Result" DataType="Binary" Flag="Result">
</Parameter>
<Parameter Name="ListaID" DataType="TIntegerArray" Flag="In" >
</Parameter>
<Parameter Name="ShowLogotipo" DataType="Boolean" Flag="In" >
</Parameter>
@ -651,6 +661,25 @@
</Interface>
</Interfaces>
</Service>
<Service Name="srvRegistroCorreos" UID="{230D8942-F542-4BF5-A19D-208DD7C8D4AF}" Ancestor="DARemoteService">
<Group Under="{E062357C-11F0-4929-9F72-7C62D89F7912}" />
<Interfaces>
<Interface Name="Default" UID="{E7C14649-21E4-4081-AFAD-919F38ED11FF}">
<Operations>
<Operation Name="AnadirMarcaEnvio" UID="{16B18794-9621-45B6-8149-F21CF961549C}">
<Parameters>
<Parameter Name="Result" DataType="Boolean" Flag="Result">
</Parameter>
<Parameter Name="NombreTabla" DataType="String" Flag="In" >
</Parameter>
<Parameter Name="IdsTabla" DataType="TIntegerArray" Flag="In" >
</Parameter>
</Parameters>
</Operation>
</Operations>
</Interface>
</Interfaces>
</Service>
</Services>
<Structs>
<Struct Name="TRdxLoginInfo" UID="{9F208C71-2B14-4C46-949C-42D84960FC58}" AutoCreateParams="1">
@ -674,6 +703,9 @@
<Array Name="TRdxEmpresasArray" UID="{5171F34A-F889-4FD6-BE02-E83BBA41031D}">
<ElementType DataType="Integer" />
</Array>
<Array Name="TIntegerArray" UID="{B0E596EA-EEC9-42A6-84C3-B8998CE80572}">
<ElementType DataType="Integer" />
</Array>
</Arrays>
<Uses>
<Use Name="DataAbstract" UID="{555CD762-B874-46F8-AB34-1C1F8DF8E5C6}" Rodl="$(Data Abstract)\Source\DataAbstract.rodl">

226
Source/Servicios/FactuGES_Intf.pas
View File

@ -48,6 +48,7 @@ const
IsrvInfVentasArticulo_IID : TGUID = '{31CD7B1B-CA98-4F92-A6D5-B3B02360613F}';
IsrvInfMargenArticulo_IID : TGUID = '{EB5F3994-838B-41A7-B19A-D49C9B9495C2}';
IsrvImpresiones_IID : TGUID = '{7610E29E-D4FD-4253-A519-A3559D111663}';
IsrvRegistroCorreos_IID : TGUID = '{E7C14649-21E4-4081-AFAD-919F38ED11FF}';
{ Event ID's }
@ -81,8 +82,10 @@ type
IsrvInfVentasArticulo = interface;
IsrvInfMargenArticulo = interface;
IsrvImpresiones = interface;
IsrvRegistroCorreos = interface;
TRdxEmpresasArray = class;
TIntegerArray = class;
TRdxLoginInfo = class;
@ -144,6 +147,31 @@ type
property Items[Index: integer]:Integer read GetItems write SetItems; default;
end;
{ TIntegerArray }
TIntegerArray = class(TROArray)
private
fCount: Integer;
fItems : array of Integer;
protected
procedure Grow; virtual;
function GetItems(Index: integer): Integer;
procedure SetItems(Index: integer; const Value: Integer);
function GetCount: integer; override;
public
class function GetItemType: PTypeInfo; override;
class function GetItemSize: integer; override;
function GetItemRef(Index: integer): pointer; override;
procedure Clear; override;
procedure Delete(Index: integer); override;
procedure Resize(ElementCount: integer); override;
procedure Assign(iSource:TPersistent); override;
function Add(const Value:Integer): integer;
property Count : integer read GetCount;
property Items[Index: integer]:Integer read GetItems write SetItems; default;
end;
{ IsrvContactos }
IsrvContactos = interface(IDARemoteService)
['{28CCDC07-A3A4-4917-89B4-64423DC70C9D}']
@ -236,7 +264,8 @@ type
IsrvFacturasCliente = interface(IDARemoteService)
['{56B4FFF0-AB1B-46B2-BA16-ABD5360F6311}']
function GetNextAutoInc(const GeneratorName: String): Integer;
function GenerateReport(const FacturaID: String; const ShowLogotipo: Boolean): Binary;
function GenerarInforme(const ListaID: TIntegerArray; const ShowLogotipo: Boolean): Binary;
function GenerarInformeEnPDF(const ListaID: TIntegerArray; const ShowLogotipo: Boolean): Binary;
end;
{ CosrvFacturasCliente }
@ -250,7 +279,8 @@ type
function __GetInterfaceName:string; override;
function GetNextAutoInc(const GeneratorName: String): Integer;
function GenerateReport(const FacturaID: String; const ShowLogotipo: Boolean): Binary;
function GenerarInforme(const ListaID: TIntegerArray; const ShowLogotipo: Boolean): Binary;
function GenerarInformeEnPDF(const ListaID: TIntegerArray; const ShowLogotipo: Boolean): Binary;
end;
{ IsrvPedidosProveedor }
@ -720,6 +750,25 @@ type
function AnadirMarcaImpresion(const NombreTabla: String; const IdsTabla: String): Boolean;
end;
{ IsrvRegistroCorreos }
IsrvRegistroCorreos = interface(IDARemoteService)
['{E7C14649-21E4-4081-AFAD-919F38ED11FF}']
function AnadirMarcaEnvio(const NombreTabla: String; const IdsTabla: TIntegerArray): Boolean;
end;
{ CosrvRegistroCorreos }
CosrvRegistroCorreos = class
class function Create(const aMessage: IROMessage; aTransportChannel: IROTransportChannel): IsrvRegistroCorreos;
end;
{ TsrvRegistroCorreos_Proxy }
TsrvRegistroCorreos_Proxy = class(TDARemoteService_Proxy, IsrvRegistroCorreos)
protected
function __GetInterfaceName:string; override;
function AnadirMarcaEnvio(const NombreTabla: String; const IdsTabla: TIntegerArray): Boolean;
end;
implementation
uses
@ -826,6 +875,106 @@ begin
Inc(fCount);
end;
{ TIntegerArray }
procedure TIntegerArray.Assign(iSource: TPersistent);
var lSource:TIntegerArray;
i:integer;
begin
if (iSource is TIntegerArray) then begin
lSource := TIntegerArray(iSource);
Clear();
Resize(lSource.Count);
for i := 0 to Count-1 do begin
Items[i] := lSource.Items[i];
end;
end
else begin
inherited Assign(iSource);
end;
end;
class function TIntegerArray.GetItemType: PTypeInfo;
begin
result := TypeInfo(Integer);
end;
class function TIntegerArray.GetItemSize: integer;
begin
result := SizeOf(Integer);
end;
function TIntegerArray.GetItems(Index: integer): Integer;
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
result := fItems[Index];
end;
function TIntegerArray.GetItemRef(Index: integer): pointer;
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
result := @fItems[Index];
end;
procedure TIntegerArray.Clear;
begin
SetLength(fItems, 0);
FCount := 0;
end;
procedure TIntegerArray.Delete(Index: integer);
var i: integer;
begin
if (Index>=Count) then RaiseError(err_InvalidIndex, [Index]);
if (Index<Count-1) then
for i := Index to Count-2 do fItems[i] := fItems[i+1];
SetLength(fItems, Count-1);
Dec(FCount);
end;
procedure TIntegerArray.SetItems(Index: integer; const Value: Integer);
begin
if (Index < 0) or (Index >= Count) then RaiseError(err_ArrayIndexOutOfBounds,[Index]);
fItems[Index] := Value;
end;
procedure TIntegerArray.Resize(ElementCount: integer);
begin
SetLength(fItems, ElementCount);
FCount := ElementCount;
end;
function TIntegerArray.GetCount: integer;
begin
result := FCount;
end;
procedure TIntegerArray.Grow;
var
Delta, Capacity: Integer;
begin
Capacity := Length(fItems);
if Capacity > 64 then
Delta := Capacity div 4
else
if Capacity > 8 then
Delta := 16
else
Delta := 4;
SetLength(fItems, Capacity + Delta);
end;
function TIntegerArray.Add(const Value: Integer): integer;
begin
Result := Count;
if Length(fItems) = Result then
Grow;
fItems[result] := Value;
Inc(fCount);
end;
{ TRdxLoginInfo }
procedure TRdxLoginInfo.Assign(iSource: TPersistent);
@ -1187,7 +1336,7 @@ begin
end
end;
function TsrvFacturasCliente_Proxy.GenerateReport(const FacturaID: String; const ShowLogotipo: Boolean): Binary;
function TsrvFacturasCliente_Proxy.GenerarInforme(const ListaID: TIntegerArray; const ShowLogotipo: Boolean): Binary;
var
__request, __response : TMemoryStream;
begin
@ -1196,8 +1345,33 @@ begin
__response := TMemoryStream.Create;
try
__Message.Initialize(__TransportChannel, 'FactuGES', __InterfaceName, 'GenerateReport');
__Message.Write('FacturaID', TypeInfo(String), FacturaID, []);
__Message.Initialize(__TransportChannel, 'FactuGES', __InterfaceName, 'GenerarInforme');
__Message.Write('ListaID', TypeInfo(FactuGES_Intf.TIntegerArray), ListaID, []);
__Message.Write('ShowLogotipo', TypeInfo(Boolean), ShowLogotipo, []);
__Message.Finalize;
__Message.WriteToStream(__request);
__TransportChannel.Dispatch(__request, __response);
__Message.ReadFromStream(__response);
__Message.Read('Result', TypeInfo(Binary), result, []);
finally
__request.Free;
__response.Free;
end
end;
function TsrvFacturasCliente_Proxy.GenerarInformeEnPDF(const ListaID: TIntegerArray; const ShowLogotipo: Boolean): Binary;
var
__request, __response : TMemoryStream;
begin
result := nil;
__request := TMemoryStream.Create;
__response := TMemoryStream.Create;
try
__Message.Initialize(__TransportChannel, 'FactuGES', __InterfaceName, 'GenerarInformeEnPDF');
__Message.Write('ListaID', TypeInfo(FactuGES_Intf.TIntegerArray), ListaID, []);
__Message.Write('ShowLogotipo', TypeInfo(Boolean), ShowLogotipo, []);
__Message.Finalize;
@ -2412,9 +2586,48 @@ begin
end
end;
{ CosrvRegistroCorreos }
class function CosrvRegistroCorreos.Create(const aMessage: IROMessage; aTransportChannel: IROTransportChannel): IsrvRegistroCorreos;
begin
result := TsrvRegistroCorreos_Proxy.Create(aMessage, aTransportChannel);
end;
{ TsrvRegistroCorreos_Proxy }
function TsrvRegistroCorreos_Proxy.__GetInterfaceName:string;
begin
result := 'srvRegistroCorreos';
end;
function TsrvRegistroCorreos_Proxy.AnadirMarcaEnvio(const NombreTabla: String; const IdsTabla: TIntegerArray): Boolean;
var
__request, __response : TMemoryStream;
begin
__request := TMemoryStream.Create;
__response := TMemoryStream.Create;
try
__Message.Initialize(__TransportChannel, 'FactuGES', __InterfaceName, 'AnadirMarcaEnvio');
__Message.Write('NombreTabla', TypeInfo(String), NombreTabla, []);
__Message.Write('IdsTabla', TypeInfo(FactuGES_Intf.TIntegerArray), IdsTabla, []);
__Message.Finalize;
__Message.WriteToStream(__request);
__TransportChannel.Dispatch(__request, __response);
__Message.ReadFromStream(__response);
__Message.Read('Result', TypeInfo(Boolean), result, []);
finally
__request.Free;
__response.Free;
end
end;
initialization
RegisterROClass(TRdxLoginInfo);
RegisterROClass(TRdxEmpresasArray);
RegisterROClass(TIntegerArray);
RegisterProxyClass(IsrvContactos_IID, TsrvContactos_Proxy);
RegisterProxyClass(IsrvComisiones_IID, TsrvComisiones_Proxy);
RegisterProxyClass(IsrvLogin_IID, TsrvLogin_Proxy);
@ -2443,11 +2656,13 @@ initialization
RegisterProxyClass(IsrvInfVentasArticulo_IID, TsrvInfVentasArticulo_Proxy);
RegisterProxyClass(IsrvInfMargenArticulo_IID, TsrvInfMargenArticulo_Proxy);
RegisterProxyClass(IsrvImpresiones_IID, TsrvImpresiones_Proxy);
RegisterProxyClass(IsrvRegistroCorreos_IID, TsrvRegistroCorreos_Proxy);
finalization
UnregisterROClass(TRdxLoginInfo);
UnregisterROClass(TRdxEmpresasArray);
UnregisterROClass(TIntegerArray);
UnregisterProxyClass(IsrvContactos_IID);
UnregisterProxyClass(IsrvComisiones_IID);
UnregisterProxyClass(IsrvLogin_IID);
@ -2476,5 +2691,6 @@ finalization
UnregisterProxyClass(IsrvInfVentasArticulo_IID);
UnregisterProxyClass(IsrvInfMargenArticulo_IID);
UnregisterProxyClass(IsrvImpresiones_IID);
UnregisterProxyClass(IsrvRegistroCorreos_IID);
end.

86
Source/Servicios/FactuGES_Invk.pas
View File

@ -56,7 +56,8 @@ type
protected
published
procedure Invoke_GetNextAutoInc(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
procedure Invoke_GenerateReport(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
procedure Invoke_GenerarInforme(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
procedure Invoke_GenerarInformeEnPDF(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
end;
TsrvPedidosProveedor_Invoker = class(TDARemoteService_Invoker)
@ -234,6 +235,13 @@ type
procedure Invoke_AnadirMarcaImpresion(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
end;
TsrvRegistroCorreos_Invoker = class(TDARemoteService_Invoker)
private
protected
published
procedure Invoke_AnadirMarcaEnvio(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
end;
implementation
uses
@ -469,28 +477,61 @@ begin
end;
end;
procedure TsrvFacturasCliente_Invoker.Invoke_GenerateReport(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
{ function GenerateReport(const FacturaID: String; const ShowLogotipo: Boolean): Binary; }
procedure TsrvFacturasCliente_Invoker.Invoke_GenerarInforme(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
{ function GenerarInforme(const ListaID: TIntegerArray; const ShowLogotipo: Boolean): Binary; }
var
FacturaID: String;
ListaID: FactuGES_Intf.TIntegerArray;
ShowLogotipo: Boolean;
lResult: Binary;
__lObjectDisposer: TROObjectDisposer;
begin
ListaID := nil;
lResult := nil;
try
__Message.Read('FacturaID', TypeInfo(String), FacturaID, []);
__Message.Read('ListaID', TypeInfo(FactuGES_Intf.TIntegerArray), ListaID, []);
__Message.Read('ShowLogotipo', TypeInfo(Boolean), ShowLogotipo, []);
lResult := (__Instance as IsrvFacturasCliente).GenerateReport(FacturaID, ShowLogotipo);
lResult := (__Instance as IsrvFacturasCliente).GenerarInforme(ListaID, ShowLogotipo);
__Message.Initialize(__Transport, 'FactuGES', 'srvFacturasCliente', 'GenerateReportResponse');
__Message.Initialize(__Transport, 'FactuGES', 'srvFacturasCliente', 'GenerarInformeResponse');
__Message.Write('Result', TypeInfo(Binary), lResult, []);
__Message.Finalize;
finally
__lObjectDisposer := TROObjectDisposer.Create(__Instance);
try
__lObjectDisposer.Add(ListaID);
__lObjectDisposer.Add(lResult);
finally
__lObjectDisposer.Free();
end;
end;
end;
procedure TsrvFacturasCliente_Invoker.Invoke_GenerarInformeEnPDF(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
{ function GenerarInformeEnPDF(const ListaID: TIntegerArray; const ShowLogotipo: Boolean): Binary; }
var
ListaID: FactuGES_Intf.TIntegerArray;
ShowLogotipo: Boolean;
lResult: Binary;
__lObjectDisposer: TROObjectDisposer;
begin
ListaID := nil;
lResult := nil;
try
__Message.Read('ListaID', TypeInfo(FactuGES_Intf.TIntegerArray), ListaID, []);
__Message.Read('ShowLogotipo', TypeInfo(Boolean), ShowLogotipo, []);
lResult := (__Instance as IsrvFacturasCliente).GenerarInformeEnPDF(ListaID, ShowLogotipo);
__Message.Initialize(__Transport, 'FactuGES', 'srvFacturasCliente', 'GenerarInformeEnPDFResponse');
__Message.Write('Result', TypeInfo(Binary), lResult, []);
__Message.Finalize;
finally
__lObjectDisposer := TROObjectDisposer.Create(__Instance);
try
__lObjectDisposer.Add(ListaID);
__lObjectDisposer.Add(lResult);
finally
__lObjectDisposer.Free();
@ -1415,4 +1456,35 @@ begin
end;
end;
{ TsrvRegistroCorreos_Invoker }
procedure TsrvRegistroCorreos_Invoker.Invoke_AnadirMarcaEnvio(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
{ function AnadirMarcaEnvio(const NombreTabla: String; const IdsTabla: TIntegerArray): Boolean; }
var
NombreTabla: String;
IdsTabla: FactuGES_Intf.TIntegerArray;
lResult: Boolean;
__lObjectDisposer: TROObjectDisposer;
begin
IdsTabla := nil;
try
__Message.Read('NombreTabla', TypeInfo(String), NombreTabla, []);
__Message.Read('IdsTabla', TypeInfo(FactuGES_Intf.TIntegerArray), IdsTabla, []);
lResult := (__Instance as IsrvRegistroCorreos).AnadirMarcaEnvio(NombreTabla, IdsTabla);
__Message.Initialize(__Transport, 'FactuGES', 'srvRegistroCorreos', 'AnadirMarcaEnvioResponse');
__Message.Write('Result', TypeInfo(Boolean), lResult, []);
__Message.Finalize;
finally
__lObjectDisposer := TROObjectDisposer.Create(__Instance);
try
__lObjectDisposer.Add(IdsTabla);
finally
__lObjectDisposer.Free();
end;
end;
end;
end.

BIN
Source/Servicios/RODLFILE.res
View File

Binary file not shown.

8
Source/Servidor/FactuGES_Server.bdsproj
View File

@ -154,7 +154,7 @@
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
<VersionInfo Name="MajorVer">3</VersionInfo>
<VersionInfo Name="MinorVer">0</VersionInfo>
<VersionInfo Name="Release">7</VersionInfo>
<VersionInfo Name="Release">6</VersionInfo>
<VersionInfo Name="Build">0</VersionInfo>
<VersionInfo Name="Debug">False</VersionInfo>
<VersionInfo Name="PreRelease">False</VersionInfo>
@ -167,15 +167,15 @@
<VersionInfoKeys>
<VersionInfoKeys Name="CompanyName">Rodax Software S.L.</VersionInfoKeys>
<VersionInfoKeys Name="FileDescription"></VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">3.0.7.0</VersionInfoKeys>
<VersionInfoKeys Name="FileVersion">3.0.6.0</VersionInfoKeys>
<VersionInfoKeys Name="InternalName"></VersionInfoKeys>
<VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys>
<VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys>
<VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys>
<VersionInfoKeys Name="ProductName">FactuGES Server</VersionInfoKeys>
<VersionInfoKeys Name="ProductVersion">3.0.7.0</VersionInfoKeys>
<VersionInfoKeys Name="ProductVersion">3.0.6.0</VersionInfoKeys>
<VersionInfoKeys Name="Comments"></VersionInfoKeys>
<VersionInfoKeys Name="CompileDate">lunes, 22 de septiembre de 2008 14:11</VersionInfoKeys></VersionInfoKeys> <Excluded_Packages>
<VersionInfoKeys Name="CompileDate">jueves, 18 de septiembre de 2008 18:56</VersionInfoKeys></VersionInfoKeys> <Excluded_Packages>
<Excluded_Packages Name="C:\Archivos de programa\RemObjects Software\Pascal Script\Dcu\D10\PascalScript_RO_D10.bpl">RemObjects Pascal Script - RemObjects SDK 3.0 Integration</Excluded_Packages>
</Excluded_Packages>
</Delphi.Personality>

13
Source/Servidor/FactuGES_Server.dpr
View File

@ -104,8 +104,6 @@ uses
schTiendaWebClient_Intf in '..\Modulos\Tienda web\Model\schTiendaWebClient_Intf.pas',
schTiendaWebServer_Intf in '..\Modulos\Tienda web\Model\schTiendaWebServer_Intf.pas',
uRptEtiquetasContactos_Server in '..\Modulos\Contactos\Reports\uRptEtiquetasContactos_Server.pas' {RptEtiquetasContactos: TDataModule},
schContactosClient_Intf in '..\Modulos\Contactos\Model\schContactosClient_Intf.pas',
schContactosServer_Intf in '..\Modulos\Contactos\Model\schContactosServer_Intf.pas',
schInformesClient_Intf in '..\Modulos\Informes base\Model\schInformesClient_Intf.pas',
schInformesServer_Intf in '..\Modulos\Informes base\Model\schInformesServer_Intf.pas',
schInventarioClient_Intf in '..\Modulos\Inventario\Model\schInventarioClient_Intf.pas',
@ -122,6 +120,10 @@ uses
schFacturasClienteServer_Intf in '..\Modulos\Facturas de cliente\Model\schFacturasClienteServer_Intf.pas',
schPedidosProveedorClient_Intf in '..\Modulos\Pedidos a proveedor\Model\schPedidosProveedorClient_Intf.pas',
schPedidosProveedorServer_Intf in '..\Modulos\Pedidos a proveedor\Model\schPedidosProveedorServer_Intf.pas',
schAlbaranesClienteClient_Intf in '..\Modulos\Albaranes de cliente\Model\schAlbaranesClienteClient_Intf.pas',
schAlbaranesClienteServer_Intf in '..\Modulos\Albaranes de cliente\Model\schAlbaranesClienteServer_Intf.pas',
schAlbaranesProveedorClient_Intf in '..\Modulos\Albaranes de proveedor\Model\schAlbaranesProveedorClient_Intf.pas',
schAlbaranesProveedorServer_Intf in '..\Modulos\Albaranes de proveedor\Model\schAlbaranesProveedorServer_Intf.pas',
schFacturasProveedorClient_Intf in '..\Modulos\Facturas de proveedor\Model\schFacturasProveedorClient_Intf.pas',
schFacturasProveedorServer_Intf in '..\Modulos\Facturas de proveedor\Model\schFacturasProveedorServer_Intf.pas',
schRemesasProveedorClient_Intf in '..\Modulos\Remesas de proveedor\Model\schRemesasProveedorClient_Intf.pas',
@ -132,10 +134,9 @@ uses
schRecibosClienteServer_Intf in '..\Modulos\Recibos de cliente\Model\schRecibosClienteServer_Intf.pas',
schPedidosClienteClient_Intf in '..\Modulos\Pedidos de cliente\Model\schPedidosClienteClient_Intf.pas',
schPedidosClienteServer_Intf in '..\Modulos\Pedidos de cliente\Model\schPedidosClienteServer_Intf.pas',
schAlbaranesClienteClient_Intf in '..\Modulos\Albaranes de cliente\Model\schAlbaranesClienteClient_Intf.pas',
schAlbaranesClienteServer_Intf in '..\Modulos\Albaranes de cliente\Model\schAlbaranesClienteServer_Intf.pas',
schAlbaranesProveedorClient_Intf in '..\Modulos\Albaranes de proveedor\Model\schAlbaranesProveedorClient_Intf.pas',
schAlbaranesProveedorServer_Intf in '..\Modulos\Albaranes de proveedor\Model\schAlbaranesProveedorServer_Intf.pas';
schContactosClient_Intf in '..\Modulos\Contactos\Model\schContactosClient_Intf.pas',
schContactosServer_Intf in '..\Modulos\Contactos\Model\schContactosServer_Intf.pas',
srvRegistroCorreos_Impl in '..\Modulos\Registro de correos\Servidor\srvRegistroCorreos_Impl.pas';
{$R *.res}
{$R ..\Servicios\RODLFile.res}

2
Source/Servidor/FactuGES_Server.rc
View File

@ -16,7 +16,7 @@ BEGIN
VALUE "FileVersion", "3.0.6.0\0"
VALUE "ProductName", "FactuGES Server\0"
VALUE "ProductVersion", "3.0.6.0\0"
VALUE "CompileDate", "lunes, 22 de septiembre de 2008 14:11\0"
VALUE "CompileDate", "lunes, 22 de septiembre de 2008 15:20\0"
END
END
BLOCK "VarFileInfo"

BIN
Source/Servidor/FactuGES_Server.res
View File

Binary file not shown.

10
Source/Servidor/uDataModuleServer.dfm
View File

@ -3,7 +3,7 @@ object dmServer: TdmServer
OnCreate = DataModuleCreate
OnDestroy = DataModuleDestroy
Height = 307
Width = 382
Width = 399
object HTTPServer: TROIndyHTTPServer
Encryption.UseCompression = True
Dispatchers = <
@ -33,8 +33,8 @@ object dmServer: TdmServer
object DriverManager: TDADriverManager
DriverDirectory = '%SYSTEM%\'
AutoLoad = True
TraceActive = False
TraceFlags = [toPrepare, toExecute, toError, toStmt, toConnect, toTransact, toMisc]
TraceActive = True
TraceFlags = [toExecute, toError, toStmt, toConnect, toTransact, toMisc]
OnTraceEvent = DriverManagerTraceEvent
Left = 136
Top = 80
@ -82,7 +82,7 @@ object dmServer: TdmServer
object SessionManager: TROInMemorySessionManager
SessionDuration = -1
OnSessionDeleted = SessionManagerSessionDeleted
Left = 216
Left = 232
Top = 16
end
object JvLogFile1: TJvLogFile
@ -102,7 +102,7 @@ object dmServer: TdmServer
object ADOQuery1: TADOQuery
Parameters = <>
Left = 320
Top = 224
Top = 208
end
object ADOConnection1: TADOConnection
Left = 248