diff --git a/Build/Build.fbp5 b/Build/Build.fbp5
index e2a47e5c..b02e8c2c 100644
--- a/Build/Build.fbp5
+++ b/Build/Build.fbp5
@@ -287,7 +287,7 @@ source_path
- True
+ False
True
False
True
@@ -530,7 +530,7 @@ source_path
False
0
- True
+ False
0
1000
False
@@ -579,7 +579,7 @@ source_path
0
%source_path%\Servidor\FactuGES_Server.dpr
True
- 2
+ 5
rcBorland
@@ -594,15 +594,15 @@ source_path
True
@@ -20604,7 +20604,7 @@ Comments=
0
%source_path%\Cliente\FactuGES.dpr
True
- 2
+ 5
rcBorland
@@ -20619,13 +20619,13 @@ Comments=
False
diff --git a/Database/FACTUGES.FDB b/Database/FACTUGES.FDB
index 1893359e..231b166d 100644
Binary files a/Database/FACTUGES.FDB and b/Database/FACTUGES.FDB differ
diff --git a/Database/VISTAS.SQL b/Database/VISTAS.SQL
index 14f29c90..90065b60 100644
--- a/Database/VISTAS.SQL
+++ b/Database/VISTAS.SQL
@@ -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);
\ No newline at end of file
+and (ARTICULOS.INVENTARIABLE = 1);
diff --git a/Database/factuges.sql b/Database/factuges.sql
index d6ba36df..848ac355 100644
--- a/Database/factuges.sql
+++ b/Database/factuges.sql
@@ -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;
\ No newline at end of file
+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;
\ No newline at end of file
diff --git a/Source/Base/Base.dpk b/Source/Base/Base.dpk
index 3eeb9f3d..165358ed 100644
--- a/Source/Base/Base.dpk
+++ b/Source/Base/Base.dpk
@@ -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.
diff --git a/Source/Base/Base.res b/Source/Base/Base.res
index 8b251f31..1641339f 100644
Binary files a/Source/Base/Base.res and b/Source/Base/Base.res differ
diff --git a/Source/Base/GUIBase/GUIBase.dpk b/Source/Base/GUIBase/GUIBase.dpk
index 6f53b2df..3b7a8182 100644
--- a/Source/Base/GUIBase/GUIBase.dpk
+++ b/Source/Base/GUIBase/GUIBase.dpk
@@ -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.
diff --git a/Source/Base/GUIBase/uDialogElegirEMail.dfm b/Source/Base/GUIBase/uDialogElegirEMail.dfm
new file mode 100644
index 00000000..9d437d5f
--- /dev/null
+++ b/Source/Base/GUIBase/uDialogElegirEMail.dfm
@@ -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
diff --git a/Source/Base/GUIBase/uDialogElegirEMail.pas b/Source/Base/GUIBase/uDialogElegirEMail.pas
new file mode 100644
index 00000000..2cb763b6
--- /dev/null
+++ b/Source/Base/GUIBase/uDialogElegirEMail.pas
@@ -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.
diff --git a/Source/Base/GUIBase/uDialogListaEnvioEMail.dfm b/Source/Base/GUIBase/uDialogListaEnvioEMail.dfm
new file mode 100644
index 00000000..d5dda91f
--- /dev/null
+++ b/Source/Base/GUIBase/uDialogListaEnvioEMail.dfm
@@ -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
diff --git a/Source/Base/GUIBase/uDialogListaEnvioEMail.pas b/Source/Base/GUIBase/uDialogListaEnvioEMail.pas
new file mode 100644
index 00000000..d6e5e6b3
--- /dev/null
+++ b/Source/Base/GUIBase/uDialogListaEnvioEMail.pas
@@ -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.
diff --git a/Source/Base/GUIBase/uViewGridBase.pas b/Source/Base/GUIBase/uViewGridBase.pas
index d79d0b04..6409f594 100644
--- a/Source/Base/GUIBase/uViewGridBase.pas
+++ b/Source/Base/GUIBase/uViewGridBase.pas
@@ -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
//
diff --git a/Source/Base/Utiles/uEMailUtils.pas b/Source/Base/Utiles/uEMailUtils.pas
new file mode 100644
index 00000000..80299c57
--- /dev/null
+++ b/Source/Base/Utiles/uEMailUtils.pas
@@ -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.
diff --git a/Source/Base/Utiles/uIntegerListUtils.pas b/Source/Base/Utiles/uIntegerListUtils.pas
index 62994ac7..b6bb65f8 100644
--- a/Source/Base/Utiles/uIntegerListUtils.pas
+++ b/Source/Base/Utiles/uIntegerListUtils.pas
@@ -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.
+
diff --git a/Source/Base/Utiles/uSistemaFunc.pas b/Source/Base/Utiles/uSistemaFunc.pas
index 1839cb51..b533d69f 100644
--- a/Source/Base/Utiles/uSistemaFunc.pas
+++ b/Source/Base/Utiles/uSistemaFunc.pas
@@ -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.
-
\ No newline at end of file
+
diff --git a/Source/Iconos/Generales/16x16/Mail.png b/Source/Iconos/Generales/16x16/Mail.png
new file mode 100644
index 00000000..640a3883
Binary files /dev/null and b/Source/Iconos/Generales/16x16/Mail.png differ
diff --git a/Source/Iconos/Generales/16x16/header_email.png b/Source/Iconos/Generales/16x16/header_email.png
new file mode 100644
index 00000000..0fc1e5fb
Binary files /dev/null and b/Source/Iconos/Generales/16x16/header_email.png differ
diff --git a/Source/Iconos/Generales/16x16/header_printer.png b/Source/Iconos/Generales/16x16/header_printer.png
new file mode 100644
index 00000000..9a501783
Binary files /dev/null and b/Source/Iconos/Generales/16x16/header_printer.png differ
diff --git a/Source/Iconos/Generales/24x24/Mail.png b/Source/Iconos/Generales/24x24/Mail.png
new file mode 100644
index 00000000..50a75e4f
Binary files /dev/null and b/Source/Iconos/Generales/24x24/Mail.png differ
diff --git a/Source/Iconos/Generales/28x28/Mail.png b/Source/Iconos/Generales/28x28/Mail.png
new file mode 100644
index 00000000..3a625cfb
Binary files /dev/null and b/Source/Iconos/Generales/28x28/Mail.png differ
diff --git a/Source/Modulos/Contactos/Data/uDataModuleClientes.dfm b/Source/Modulos/Contactos/Data/uDataModuleClientes.dfm
index 914c380e..4f848943 100644
--- a/Source/Modulos/Contactos/Data/uDataModuleClientes.dfm
+++ b/Source/Modulos/Contactos/Data/uDataModuleClientes.dfm
@@ -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
diff --git a/Source/Modulos/Contactos/Data/uDataModuleProveedores.dfm b/Source/Modulos/Contactos/Data/uDataModuleProveedores.dfm
index 7c148002..906d67ff 100644
--- a/Source/Modulos/Contactos/Data/uDataModuleProveedores.dfm
+++ b/Source/Modulos/Contactos/Data/uDataModuleProveedores.dfm
@@ -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
diff --git a/Source/Modulos/Contactos/Model/Contactos_model.bdsproj b/Source/Modulos/Contactos/Model/Contactos_model.bdsproj
index 9466337d..bcf1ab37 100644
--- a/Source/Modulos/Contactos/Model/Contactos_model.bdsproj
+++ b/Source/Modulos/Contactos/Model/Contactos_model.bdsproj
@@ -176,7 +176,7 @@
JCL Open and Save IDE dialogs with favorite folders
-