diff --git a/Build/Build.fbp5 b/Build/Build.fbp5
index d9f11750..43f1a8ab 100644
--- a/Build/Build.fbp5
+++ b/Build/Build.fbp5
@@ -702,12 +702,12 @@ source_path
2
0
- 2
+ 3
False
0
%source_path%\Servidor\FactuGES_Server.dpr
True
- 3
+ 1
rcBorland
@@ -722,15 +722,15 @@ source_path
True
@@ -6788,7 +6788,7 @@ Comments=
%library_path%
0
False
- 0
+ 3
1048576
16384
@@ -6916,7 +6916,7 @@ Comments=
%library_path%
0
False
- 0
+ 3
1048576
16384
@@ -7754,7 +7754,7 @@ Comments=
False
False
False
- False
+ True
True
False
False
@@ -7764,7 +7764,7 @@ Comments=
False
False
False
- 3081
+ 3082
1
@@ -7788,7 +7788,16 @@ Comments=
[usPackages,usCompiler,usLinker,usVersionInfo]
False
False
-
@@ -8264,7 +8273,7 @@ Comments=
False
False
False
- False
+ True
True
False
False
@@ -8274,7 +8283,7 @@ Comments=
False
False
False
- 3081
+ 3082
1
@@ -8297,7 +8306,16 @@ Comments=
[usPackages,usCompiler,usLinker,usVersionInfo]
False
False
-
@@ -8882,7 +8900,7 @@ Comments=
False
False
False
- False
+ True
True
False
False
@@ -8892,7 +8910,7 @@ Comments=
False
False
False
- 3081
+ 3082
1
@@ -8915,7 +8933,16 @@ Comments=
[usPackages,usCompiler,usLinker,usVersionInfo]
False
False
-
@@ -9409,7 +9436,7 @@ Comments=
False
False
False
- False
+ True
True
False
False
@@ -9419,7 +9446,7 @@ Comments=
False
False
False
- 3081
+ 3082
1
@@ -9443,7 +9470,16 @@ Comments=
[usPackages,usCompiler,usLinker,usVersionInfo]
False
False
-
@@ -9528,7 +9564,7 @@ Comments=
False
False
False
- False
+ True
True
False
False
@@ -9538,7 +9574,7 @@ Comments=
False
False
False
- 3081
+ 3082
1
@@ -9562,7 +9598,16 @@ Comments=
[usPackages,usCompiler,usLinker,usVersionInfo]
False
False
-
@@ -10380,7 +10425,7 @@ Comments=
False
False
False
- False
+ True
True
False
False
@@ -10390,7 +10435,7 @@ Comments=
False
False
False
- 3081
+ 3082
1
@@ -10414,7 +10459,16 @@ Comments=
[usPackages,usCompiler,usLinker,usVersionInfo]
False
False
-
@@ -11168,7 +11222,7 @@ Comments=
False
False
False
- False
+ True
True
False
False
@@ -11178,7 +11232,7 @@ Comments=
False
False
False
- 3081
+ 3082
1
@@ -11202,7 +11256,16 @@ Comments=
[usPackages,usCompiler,usLinker,usVersionInfo]
False
False
-
@@ -13261,7 +13324,7 @@ Comments=
False
False
False
- False
+ True
True
False
False
@@ -13271,7 +13334,7 @@ Comments=
False
False
False
- 3081
+ 3082
1
@@ -13295,7 +13358,16 @@ Comments=
[usPackages,usCompiler,usLinker,usVersionInfo]
False
False
-
@@ -13756,7 +13828,7 @@ Comments=
False
False
False
- False
+ True
True
False
False
@@ -13766,7 +13838,7 @@ Comments=
False
False
False
- 3081
+ 3082
1
@@ -13790,7 +13862,16 @@ Comments=
[usPackages,usCompiler,usLinker,usVersionInfo]
False
False
-
@@ -18068,7 +18149,7 @@ Comments=
False
False
False
- False
+ True
True
False
False
@@ -18078,7 +18159,7 @@ Comments=
False
False
False
- 3081
+ 3082
1
@@ -18102,7 +18183,16 @@ Comments=
[usPackages,usCompiler,usLinker,usVersionInfo]
False
False
-
@@ -18681,7 +18771,7 @@ Comments=
False
False
False
- False
+ True
True
False
False
@@ -18691,9 +18781,9 @@ Comments=
False
False
False
- 3081
+ 3082
- 0
+ 1
0
0
@@ -18716,13 +18806,13 @@ Comments=
False
@@ -18736,17 +18826,14 @@ Comments=
False
False
%package_path%
-
+
False
%modules_dcp_path%
- True
+ False
- True
+ False
False
True
@@ -18760,8 +18847,8 @@ Comments=
True
%library_path%
0
- True
- 3
+ False
+ 0
1048576
16384
@@ -18772,7 +18859,7 @@ Comments=
False
fa8
- True
+ False
False
True
@@ -18811,7 +18898,7 @@ Comments=
False
False
False
- False
+ True
True
False
False
@@ -18821,9 +18908,9 @@ Comments=
False
False
False
- 3081
+ 3082
- 0
+ 1
0
0
@@ -18846,13 +18933,13 @@ Comments=
False
@@ -18866,17 +18953,14 @@ Comments=
False
False
%package_path%
-
+
False
%modules_dcp_path%
- True
+ False
- True
+ False
False
True
@@ -18890,8 +18974,8 @@ Comments=
True
%library_path%
0
- True
- 3
+ False
+ 0
1048576
16384
@@ -18902,7 +18986,7 @@ Comments=
False
fa8
- True
+ False
False
True
@@ -19486,12 +19570,12 @@ Comments=
2
0
- 1
+ 3
False
0
%source_path%\Cliente\FactuGES.dpr
True
- 4
+ 1
rcBorland
@@ -19506,13 +19590,13 @@ Comments=
False
@@ -19556,7 +19640,7 @@ Comments=
False
%output_path%\Cliente
False
- PluginSDK_D10R;GUISDK_D11;Base;GUIBase;ApplicationBase;
+ PluginSDK_D11R;GUISDK_D11R;Base;GUIBase;ApplicationBase;
False
fa8
True
diff --git a/Database/scripts/factuges.sql b/Database/scripts/factuges.sql
index cbe479b9..568297fe 100644
--- a/Database/scripts/factuges.sql
+++ b/Database/scripts/factuges.sql
@@ -410,7 +410,7 @@ CREATE TABLE COMISIONES_LIQ_VENDEDORES(
ID TIPO_ID NOT NULL,
ID_COMISION TIPO_ID,
ID_VENDEDOR TIPO_ID,
- NOMBRE VARCHAR(255) COLLATE ES_ES,
+ NOMBRE VARCHAR(255),
COMISION TIPO_PORCENTAJE,
IMPORTE_TOTAL TIPO_IMPORTE);
@@ -449,7 +449,7 @@ CREATE TABLE ALBARANES_CLIENTE (
FECHA_ENVIO DATE,
FECHA_RECEPCION DATE,
FECHA_PREVISTA_ENVIO DATE,
- REFERENCIA_CLIENTE VARCHAR(255) COLLATE ES_ES,
+ REFERENCIA_CLIENTE VARCHAR(255),
ID_TIENDA TIPO_ID
);
@@ -583,7 +583,7 @@ CREATE TABLE CLIENTES_DATOS (
CODIGO_ASIGNADO VARCHAR(255),
IGNORAR_CONTABILIDAD TIPO_ID,
TIENE_SUBCUENTA TIPO_ID,
- PROCEDENCIA_CLIENTE VARCHAR(255) COLLATE ES_ES,
+ PROCEDENCIA_CLIENTE VARCHAR(255),
VENCIMIENTO_FACTURAS_1 INTEGER,
VENCIMIENTO_FACTURAS_2 INTEGER,
VENCIMIENTO_FACTURAS_3 INTEGER
@@ -632,7 +632,7 @@ CREATE TABLE CONT_APUNTES (
ID_SUBCUENTA TIPO_ID,
NUM_ORDEN TIPO_ID,
CONCEPTO VARCHAR(255),
- DOCUMENTO VARCHAR(255) COLLATE ES_ES,
+ DOCUMENTO VARCHAR(255),
PUNTEADO SMALLINT,
DEBE TIPO_IMPORTE,
HABER TIPO_IMPORTE
@@ -848,7 +848,7 @@ CREATE TABLE EMPRESAS_TIENDAS (
NOTAS TIPO_NOTAS,
FECHA_ALTA TIMESTAMP,
FECHA_MODIFICACION TIMESTAMP,
- CODIGO_CONTABLE VARCHAR(2) COLLATE ES_ES
+ CODIGO_CONTABLE VARCHAR(2)
);
CREATE TABLE EMPRESAS_USUARIOS (
@@ -1068,7 +1068,7 @@ CREATE TABLE PEDIDOS_CLIENTE (
ID_FORMA_PAGO TIPO_ID,
REF_TIENDA_WEB INTEGER,
FECHA_PREVISTA_ENVIO DATE,
- REFERENCIA_CLIENTE VARCHAR(255) COLLATE ES_ES,
+ REFERENCIA_CLIENTE VARCHAR(255),
ID_TIENDA TIPO_ID
);
@@ -1190,8 +1190,8 @@ CREATE TABLE PRESUPUESTOS_CLIENTE (
IMPORTE_IVA TIPO_IMPORTE,
IMPORTE_TOTAL TIPO_IMPORTE,
ID_FORMA_PAGO TIPO_ID,
- REFERENCIA_CLIENTE VARCHAR(255) COLLATE ES_ES,
- CLIENTE_FINAL VARCHAR(255) COLLATE ES_ES,
+ REFERENCIA_CLIENTE VARCHAR(255),
+ CLIENTE_FINAL VARCHAR(255),
ID_TIENDA TIPO_ID,
ID_VENDEDOR TIPO_ID
);
@@ -1262,12 +1262,12 @@ CREATE TABLE RECIBOS_CLIENTE (
ID_REMESA TIPO_ID,
ID_RECIBO_COMPENSADO INTEGER,
ID_TIENDA TIPO_ID,
- NIF_CIF VARCHAR(15) COLLATE ES_ES,
- NOMBRE VARCHAR(255) COLLATE ES_ES,
- CALLE VARCHAR(255) COLLATE ES_ES,
- POBLACION VARCHAR(255) COLLATE ES_ES,
- PROVINCIA VARCHAR(255) COLLATE ES_ES,
- CODIGO_POSTAL VARCHAR(10) COLLATE ES_ES
+ NIF_CIF VARCHAR(15),
+ NOMBRE VARCHAR(255),
+ CALLE VARCHAR(255),
+ POBLACION VARCHAR(255),
+ PROVINCIA VARCHAR(255),
+ CODIGO_POSTAL VARCHAR(10)
);
@@ -1290,12 +1290,12 @@ CREATE TABLE RECIBOS_PROVEEDOR (
ID_REMESA TIPO_ID,
ID_RECIBO_COMPENSADO INTEGER,
ID_TIENDA TIPO_ID,
- NIF_CIF VARCHAR(15) COLLATE ES_ES,
- NOMBRE VARCHAR(255) COLLATE ES_ES,
- CALLE VARCHAR(255) COLLATE ES_ES,
- POBLACION VARCHAR(255) COLLATE ES_ES,
- PROVINCIA VARCHAR(255) COLLATE ES_ES,
- CODIGO_POSTAL VARCHAR(10) COLLATE ES_ES
+ NIF_CIF VARCHAR(15),
+ NOMBRE VARCHAR(255),
+ CALLE VARCHAR(255),
+ POBLACION VARCHAR(255),
+ PROVINCIA VARCHAR(255),
+ CODIGO_POSTAL VARCHAR(10)
);
CREATE TABLE REFERENCIAS (
@@ -1304,7 +1304,7 @@ CREATE TABLE REFERENCIAS (
ID_TIENDA TIPO_ID,
CODIGO VARCHAR(50) NOT NULL,
VALOR VARCHAR(255) NOT NULL,
- DESCRIPCION VARCHAR(255) COLLATE ES_ES
+ DESCRIPCION VARCHAR(255)
);
CREATE TABLE REMESAS_CLIENTE (
@@ -1545,7 +1545,7 @@ SELECT
ALBARANES_CLIENTE.FECHA_ALBARAN,
ALBARANES_CLIENTE.REFERENCIA,
ALBARANES_CLIENTE.REFERENCIA_CLIENTE,
- ALBARANES_CLIENTE.TIPO,
+ ALBARANES_CLIENTE.TIPO,
TRIM(V_ALB_CLI_SITUACION.SITUACION),
ALBARANES_CLIENTE.ID_ALMACEN,
ALMACENES.NOMBRE AS NOMBRE_ALMACEN,
@@ -1872,10 +1872,10 @@ SELECT
CLIENTES_DATOS.IGNORAR_CONTABILIDAD,
CLIENTES_DATOS.TIENE_SUBCUENTA,
CLIENTES_DATOS.PROCEDENCIA_CLIENTE,
- CLIENTES_DATOS.VENCIMIENTO_FACTURAS_1,
- CLIENTES_DATOS.VENCIMIENTO_FACTURAS_2,
- CLIENTES_DATOS.VENCIMIENTO_FACTURAS_3
-
+ CLIENTES_DATOS.VENCIMIENTO_FACTURAS_1,
+ CLIENTES_DATOS.VENCIMIENTO_FACTURAS_2,
+ CLIENTES_DATOS.VENCIMIENTO_FACTURAS_3
+
FROM V_CONTACTOS
LEFT OUTER JOIN CLIENTES_DATOS ON (V_CONTACTOS.ID = CLIENTES_DATOS.ID_CLIENTE)
WHERE
@@ -1924,9 +1924,9 @@ CREATE VIEW V_PROVEEDORES(
TIENE_SUBCUENTA,
NOMBRE_COMERCIAL,
ES_ACREEDOR,
- VENCIMIENTO_FACTURAS_1,
- VENCIMIENTO_FACTURAS_2,
- VENCIMIENTO_FACTURAS_3)
+ VENCIMIENTO_FACTURAS_1,
+ VENCIMIENTO_FACTURAS_2,
+ VENCIMIENTO_FACTURAS_3)
AS
SELECT
V_CONTACTOS.ID,
diff --git a/Database/scripts/factuges_replicador.sql b/Database/scripts/factuges_replicador.sql
index a8391000..1333d32a 100644
--- a/Database/scripts/factuges_replicador.sql
+++ b/Database/scripts/factuges_replicador.sql
@@ -923,7 +923,7 @@ BEGIN
END
^
-CREATE TRIGGER CONTACTOS_DAT_PER_DELETE_REPL FOR CONTACTOS_DATOS_PERSONAL
+CREATE TRIGGER CONTACTOS_DATOS_PER_DEL_REPL FOR CONTACTOS_DATOS_PERSONAL
ACTIVE AFTER DELETE POSITION 0
AS
BEGIN
@@ -936,7 +936,7 @@ BEGIN
END
^
-CREATE TRIGGER CONTACTOS_DAT_PER_INSERT_REPL FOR CONTACTOS_DATOS_PERSONAL
+CREATE TRIGGER CONTACTOS_DATOS_PER_INS_REPL FOR CONTACTOS_DATOS_PERSONAL
ACTIVE AFTER INSERT POSITION 0
AS
BEGIN
@@ -949,7 +949,7 @@ BEGIN
END
^
-CREATE TRIGGER CONTACTOS_DAT_PER_UPDATE_REPL FOR CONTACTOS_DATOS_PERSONAL
+CREATE TRIGGER CONTACTOS_DATOS_PER_UPD_REPL FOR CONTACTOS_DATOS_PERSONAL
ACTIVE AFTER UPDATE POSITION 0
AS
BEGIN
@@ -1323,51 +1323,6 @@ END
^
-/* Trigger: VENDEDORES_DATOS_DELETE_REPL */
-CREATE TRIGGER VENDEDORES_DATOS_DELETE_REPL FOR VENDEDORES_DATOS
-ACTIVE AFTER DELETE POSITION 0
-AS
-BEGIN
- IF( USER <> 'REPL' ) THEN
- BEGIN
- INSERT INTO CHANGES(TABLEKEY,TABLENAME,OP,LOC_ID)
- SELECT OLD.ID_VENDEDOR,'VENDEDORES_DATOS','D',LOC_ID
- FROM REPL_TABLES WHERE TABLENAME='VENDEDORES_DATOS';
- END
-END
-^
-
-
-/* Trigger: VENDEDORES_DATOS_INSERT_REPL */
-CREATE TRIGGER VENDEDORES_DATOS_INSERT_REPL FOR VENDEDORES_DATOS
-ACTIVE AFTER INSERT POSITION 0
-AS
-BEGIN
- IF( USER <> 'REPL' ) THEN
- BEGIN
- INSERT INTO CHANGES(TABLEKEY,TABLENAME,OP,LOC_ID)
- SELECT NEW.ID_VENDEDOR,'VENDEDORES_DATOS','I',LOC_ID
- FROM REPL_TABLES WHERE TABLENAME='VENDEDORES_DATOS';
- END
-END
-^
-
-
-/* Trigger: VENDEDORES_DATOS_UPDATE_REPL */
-CREATE TRIGGER VENDEDORES_DATOS_UPDATE_REPL FOR VENDEDORES_DATOS
-ACTIVE AFTER UPDATE POSITION 0
-AS
-BEGIN
- IF( USER <> 'REPL' ) THEN
- BEGIN
- INSERT INTO CHANGES(TABLEKEY,TABLENAME,OP,LOC_ID)
- SELECT NEW.ID_VENDEDOR,'VENDEDORES_DATOS','U',LOC_ID
- FROM REPL_TABLES WHERE TABLENAME='VENDEDORES_DATOS';
- END
-END
-^
-
-
/* Trigger: EMPRESAS_CONTACTOS_DELETE_REPL */
CREATE TRIGGER EMPRESAS_CONTACTOS_DELETE_REPL FOR EMPRESAS_CONTACTOS
ACTIVE AFTER DELETE POSITION 0
@@ -1457,6 +1412,47 @@ BEGIN
END
^
+/* Trigger: EMPRESAS_TIENDAS_DELETE_REPL */
+CREATE TRIGGER EMPRESAS_TIENDAS_DELETE_REPL FOR EMPRESAS_TIENDAS
+ACTIVE AFTER DELETE POSITION 0
+AS
+BEGIN
+ IF( USER <> 'REPL' ) THEN
+ BEGIN
+ INSERT INTO CHANGES(TABLEKEY,TABLENAME,OP,LOC_ID)
+ SELECT OLD.ID,'EMPRESAS_TIENDAS','D',LOC_ID
+ FROM REPL_TABLES WHERE TABLENAME='EMPRESAS_TIENDAS';
+ END
+END
+^
+
+/* Trigger: EMPRESAS_TIENDAS_INSERT_REPL */
+CREATE TRIGGER EMPRESAS_TIENDAS_INSERT_REPL FOR EMPRESAS_TIENDAS
+ACTIVE AFTER INSERT POSITION 0
+AS
+BEGIN
+ IF( USER <> 'REPL' ) THEN
+ BEGIN
+ INSERT INTO CHANGES(TABLEKEY,TABLENAME,OP,LOC_ID)
+ SELECT NEW.ID,'EMPRESAS_TIENDAS','I',LOC_ID
+ FROM REPL_TABLES WHERE TABLENAME='EMPRESAS_TIENDAS';
+ END
+END
+^
+
+/* Trigger: EMPRESAS_TIENDAS_UPDATE_REPL */
+CREATE TRIGGER EMPRESAS_TIENDAS_UPDATE_REPL FOR EMPRESAS_TIENDAS
+ACTIVE AFTER UPDATE POSITION 0
+AS
+BEGIN
+ IF( USER <> 'REPL' ) THEN
+ BEGIN
+ INSERT INTO CHANGES(TABLEKEY,TABLENAME,OP,LOC_ID)
+ SELECT NEW.ID,'EMPRESAS_TIENDAS','U',LOC_ID
+ FROM REPL_TABLES WHERE TABLENAME='EMPRESAS_TIENDAS';
+ END
+END
+^
/* Trigger: EMPRESAS_DELETE_REPL */
CREATE TRIGGER EMPRESAS_DELETE_REPL FOR EMPRESAS
@@ -2717,6 +2713,48 @@ BEGIN
END
^
+/* Trigger: VENDEDORES_DATOS_DELETE_REPL */
+CREATE TRIGGER VENDEDORES_DATOS_DELETE_REPL FOR VENDEDORES_DATOS
+ACTIVE AFTER DELETE POSITION 0
+AS
+BEGIN
+ IF( USER <> 'REPL' ) THEN
+ BEGIN
+ INSERT INTO CHANGES(TABLEKEY,TABLENAME,OP,LOC_ID)
+ SELECT OLD.ID_VENDEDOR,'VENDEDORES_DATOS','D',LOC_ID
+ FROM REPL_TABLES WHERE TABLENAME='VENDEDORES_DATOS';
+ END
+END
+^
+
+/* Trigger: VENDEDORES_DATOS_INSERT_REPL */
+CREATE TRIGGER VENDEDORES_DATOS_INSERT_REPL FOR VENDEDORES_DATOS
+ACTIVE AFTER INSERT POSITION 0
+AS
+BEGIN
+ IF( USER <> 'REPL' ) THEN
+ BEGIN
+ INSERT INTO CHANGES(TABLEKEY,TABLENAME,OP,LOC_ID)
+ SELECT NEW.ID_VENDEDOR,'VENDEDORES_DATOS','I',LOC_ID
+ FROM REPL_TABLES WHERE TABLENAME='VENDEDORES_DATOS';
+ END
+END
+^
+
+/* Trigger: VENDEDORES_DATOS_UPDATE_REPL */
+CREATE TRIGGER VENDEDORES_DATOS_UPDATE_REPL FOR VENDEDORES_DATOS
+ACTIVE AFTER UPDATE POSITION 0
+AS
+BEGIN
+ IF( USER <> 'REPL' ) THEN
+ BEGIN
+ INSERT INTO CHANGES(TABLEKEY,TABLENAME,OP,LOC_ID)
+ SELECT NEW.ID_VENDEDOR,'VENDEDORES_DATOS','U',LOC_ID
+ FROM REPL_TABLES WHERE TABLENAME='VENDEDORES_DATOS';
+ END
+END
+^
+
/* Trigger: UNIDADES_MEDIDA_DELETE_REPL */
CREATE TRIGGER UNIDADES_MEDIDA_DELETE_REPL FOR UNIDADES_MEDIDA
diff --git a/Installer/librerias.txt b/Installer/librerias.txt
index a12bab65..18520401 100644
--- a/Installer/librerias.txt
+++ b/Installer/librerias.txt
@@ -9,11 +9,10 @@ cxIntl6D11.bpl
cxIntlPrintSys3D11.bpl
cxLibraryD11.bpl
cxPageControlD11.bpl
-cxTreeListD11.bpl
+cxTreeListD11.bpl
DataAbstract_Core_D11.bpl
dclcxLibraryD11.bpl
dxBarD11.bpl
-dxNavBarD11.bpl
dxBarExtItemsD11.bpl
dxComnD11.bpl
dxGDIPlusD11.bpl
@@ -24,12 +23,13 @@ dxPScxGrid6LnkD11.bpl
dxPSLnksD11.bpl
dxPsPrVwAdvD11.bpl
dxThemeD11.bpl
+dxCored11.bpl
frx11.bpl
frxe11.bpl
frxTee11.bpl
fs11.bpl
fsTee11.bpl
-GUISDK_D11.bpl
+GUISDK_D11R.bpl
Jcl110.bpl
JclVcl110.bpl
JSDialog100.bpl
@@ -48,7 +48,7 @@ JvSystemD11R.bpl
pckMD5.bpl
pckUCDataConnector.bpl
pckUserControl_RT.bpl
-PluginSDK_D10R.bpl
+PluginSDK_D11R.bpl
PngComponentsD10.bpl
PNG_D10.bpl
RemObjects_Core_D11.bpl
diff --git a/Source/ApplicationBase/ApplicationBase.dpk b/Source/ApplicationBase/ApplicationBase.dpk
index 108f1088..9e34b64e 100644
--- a/Source/ApplicationBase/ApplicationBase.dpk
+++ b/Source/ApplicationBase/ApplicationBase.dpk
@@ -42,7 +42,7 @@ requires
dxGDIPlusD11,
dxNavBarD11,
vcljpg,
- GUISDK_D11,
+ GUISDK_D11R,
xmlrtl,
cfpack_d11,
vclx,
diff --git a/Source/ApplicationBase/ApplicationBase.dproj b/Source/ApplicationBase/ApplicationBase.dproj
index 81b5e95b..a56c7d01 100644
--- a/Source/ApplicationBase/ApplicationBase.dproj
+++ b/Source/ApplicationBase/ApplicationBase.dproj
@@ -49,6 +49,9 @@
+
+
+
RemObjects Data Abstract - SQLite Driver
Microsoft Office 2000 Sample Automation Server Wrapper Components
Microsoft Office XP Sample Automation Server Wrapper Components
@@ -59,6 +62,29 @@
MainSource
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -73,32 +99,9 @@
TFrame
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/ApplicationBase/Ejercicios/Controller/uEjerciciosController.pas b/Source/ApplicationBase/Ejercicios/Controller/uEjerciciosController.pas
index e1fe47bd..afc0b56b 100644
--- a/Source/ApplicationBase/Ejercicios/Controller/uEjerciciosController.pas
+++ b/Source/ApplicationBase/Ejercicios/Controller/uEjerciciosController.pas
@@ -219,8 +219,7 @@ end;
function TEjerciciosController.ValidarEjercicio(AEjercicio: IBizEjercicio): Boolean;
begin
- Result := False;
-
+
if not Assigned(AEjercicio) then
raise Exception.Create ('Ejercicio no asignado');
diff --git a/Source/ApplicationBase/Ejercicios/Plugin/Ejercicios_plugin.dpk b/Source/ApplicationBase/Ejercicios/Plugin/Ejercicios_plugin.dpk
index ffc8e64b..2f1ab32a 100644
Binary files a/Source/ApplicationBase/Ejercicios/Plugin/Ejercicios_plugin.dpk and b/Source/ApplicationBase/Ejercicios/Plugin/Ejercicios_plugin.dpk differ
diff --git a/Source/ApplicationBase/Ejercicios/Plugin/Ejercicios_plugin.dproj b/Source/ApplicationBase/Ejercicios/Plugin/Ejercicios_plugin.dproj
index 40d39742..65016ee6 100644
--- a/Source/ApplicationBase/Ejercicios/Plugin/Ejercicios_plugin.dproj
+++ b/Source/ApplicationBase/Ejercicios/Plugin/Ejercicios_plugin.dproj
@@ -86,7 +86,7 @@
-
+
diff --git a/Source/ApplicationBase/Ejercicios/Servidor/srvEjercicios_Impl.pas b/Source/ApplicationBase/Ejercicios/Servidor/srvEjercicios_Impl.pas
index 0a6e2af9..9d5034db 100644
--- a/Source/ApplicationBase/Ejercicios/Servidor/srvEjercicios_Impl.pas
+++ b/Source/ApplicationBase/Ejercicios/Servidor/srvEjercicios_Impl.pas
@@ -91,7 +91,7 @@ end;
procedure TsrvEjercicios.DARemoteServiceCreate(Sender: TObject);
begin
- SessionManager := dmServer.SessionManager;
+ //SessionManager := dmServer.SessionManager;
bpEjercicios.BusinessRulesID := BIZ_SERVER_EJERCICIOS;
end;
diff --git a/Source/ApplicationBase/Ejercicios/Views/uEditorElegirEjercicios.dfm b/Source/ApplicationBase/Ejercicios/Views/uEditorElegirEjercicios.dfm
index a13405fd..89e072ff 100644
--- a/Source/ApplicationBase/Ejercicios/Views/uEditorElegirEjercicios.dfm
+++ b/Source/ApplicationBase/Ejercicios/Views/uEditorElegirEjercicios.dfm
@@ -1,44 +1,17 @@
inherited fEditorElegirEjercicios: TfEditorElegirEjercicios
Caption = 'fEditorElegirEjercicios'
ClientHeight = 533
+ ExplicitWidth = 551
ExplicitHeight = 567
PixelsPerInch = 96
TextHeight = 13
- object JvgWizardHeader1: TJvgWizardHeader [0]
- Left = 0
- Top = 27
- Width = 543
- Height = 60
- CaptionFont.Charset = DEFAULT_CHARSET
- CaptionFont.Color = clWindowText
- CaptionFont.Height = -11
- CaptionFont.Name = 'Tahoma'
- CaptionFont.Style = [fsBold]
- CommentFont.Charset = DEFAULT_CHARSET
- CommentFont.Color = clWindowText
- CommentFont.Height = -11
- CommentFont.Name = 'Tahoma'
- CommentFont.Style = []
- SymbolFont.Charset = DEFAULT_CHARSET
- SymbolFont.Color = clHighlightText
- SymbolFont.Height = -35
- SymbolFont.Name = 'Wingdings'
- SymbolFont.Style = [fsBold]
- Captions.Strings = (
- 'Seleccione la subcuenta')
- Comments.Strings = (
- ' ')
- Gradient.FromColor = clHighlight
- Gradient.ToColor = clWindow
- Gradient.Active = False
- Gradient.Orientation = fgdVertical
- BufferedDraw = False
- ExplicitLeft = -113
- ExplicitWidth = 656
+ inherited JvNavPanelHeader: TJvNavPanelHeader
+ Top = 64
+ ExplicitTop = 64
end
inherited TBXDock: TTBXDock
- Top = 87
- ExplicitTop = 87
+ Top = 91
+ ExplicitTop = 91
inherited tbxMain: TTBXToolbar
ExplicitWidth = 269
inherited TBXItem36: TTBXItem
@@ -56,13 +29,13 @@ inherited fEditorElegirEjercicios: TfEditorElegirEjercicios
ExplicitTop = 514
end
inherited frViewEjercicios1: TfrViewEjercicios
- Top = 162
- Height = 303
- ExplicitTop = 162
- ExplicitHeight = 303
+ Top = 166
+ Height = 299
+ ExplicitTop = 166
+ ExplicitHeight = 299
inherited cxGrid: TcxGrid
- Height = 175
- ExplicitHeight = 175
+ Height = 171
+ ExplicitHeight = 171
inherited cxGridView: TcxGridDBTableView
DataController.Summary.FooterSummaryItems = <
item
@@ -79,29 +52,23 @@ inherited fEditorElegirEjercicios: TfEditorElegirEjercicios
inherited TBXDockablePanel1: TTBXDockablePanel
inherited dxLayoutControl1: TdxLayoutControl
inherited txtFiltroTodo: TcxTextEdit
- Style.LookAndFeel.SkinName = ''
- StyleDisabled.LookAndFeel.SkinName = ''
- StyleFocused.LookAndFeel.SkinName = ''
- StyleHot.LookAndFeel.SkinName = ''
+ ExplicitWidth = 273
+ Width = 273
end
inherited edtFechaIniFiltro: TcxDateEdit
- Style.LookAndFeel.SkinName = ''
- StyleDisabled.LookAndFeel.SkinName = ''
- StyleFocused.LookAndFeel.SkinName = ''
- StyleHot.LookAndFeel.SkinName = ''
+ ExplicitWidth = 121
+ Width = 121
end
inherited edtFechaFinFiltro: TcxDateEdit
- Style.LookAndFeel.SkinName = ''
- StyleDisabled.LookAndFeel.SkinName = ''
- StyleFocused.LookAndFeel.SkinName = ''
- StyleHot.LookAndFeel.SkinName = ''
+ ExplicitWidth = 121
+ Width = 121
end
end
end
end
inherited pnlAgrupaciones: TTBXDockablePanel
- Top = 277
- ExplicitTop = 277
+ Top = 273
+ ExplicitTop = 273
end
inherited dxComponentPrinter: TdxComponentPrinter
inherited dxComponentPrinterLink: TdxGridReportLink
@@ -117,7 +84,7 @@ inherited fEditorElegirEjercicios: TfEditorElegirEjercicios
end>
end
end
- inline frViewBarraSeleccion1: TfrViewBarraSeleccion [5]
+ inline frViewBarraSeleccion1: TfrViewBarraSeleccion [4]
Left = 0
Top = 465
Width = 543
@@ -155,6 +122,54 @@ inherited fEditorElegirEjercicios: TfEditorElegirEjercicios
end
end
end
+ object pnlHeader: TPanel [5]
+ Left = 0
+ Top = 0
+ Width = 543
+ Height = 64
+ Align = alTop
+ BevelOuter = bvNone
+ Color = clWhite
+ Padding.Left = 25
+ Padding.Top = 8
+ Padding.Right = 25
+ Padding.Bottom = 8
+ ParentBackground = False
+ TabOrder = 5
+ object lblTitle: TLabel
+ AlignWithMargins = True
+ Left = 25
+ Top = 8
+ Width = 493
+ Height = 13
+ Margins.Left = 0
+ Margins.Top = 0
+ Margins.Right = 0
+ Margins.Bottom = 8
+ Align = alTop
+ Caption = 'Seleccione la subcuenta'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = [fsBold]
+ ParentFont = False
+ ExplicitWidth = 135
+ end
+ object lblComments: TLabel
+ AlignWithMargins = True
+ Left = 50
+ Top = 29
+ Width = 468
+ Height = 27
+ Margins.Left = 25
+ Margins.Top = 0
+ Margins.Right = 0
+ Align = alClient
+ ExplicitWidth = 3
+ ExplicitHeight = 13
+ end
+ end
inherited EditorActionList: TActionList [6]
inherited actNuevo: TAction
Enabled = False
diff --git a/Source/ApplicationBase/Ejercicios/Views/uEditorElegirEjercicios.pas b/Source/ApplicationBase/Ejercicios/Views/uEditorElegirEjercicios.pas
index 4ea754db..bb2fd4cb 100644
--- a/Source/ApplicationBase/Ejercicios/Views/uEditorElegirEjercicios.pas
+++ b/Source/ApplicationBase/Ejercicios/Views/uEditorElegirEjercicios.pas
@@ -10,16 +10,18 @@ uses
uViewGrid, uViewEjercicios, ComCtrls, JvExComCtrls, JvStatusBar, TBX,
TB2ExtItems, TBXExtItems, TB2Item, TB2Dock, TB2Toolbar, dxGDIPlusClasses,
ExtCtrls, JvExControls, JvNavigationPane, uViewBarraSeleccion, uIEditorElegirEjercicios,
- UBizEjercicios, JvgWizardHeader;
+ UBizEjercicios, StdCtrls;
type
TfEditorElegirEjercicios = class(TfEditorEjercicios, IEditorElegirEjercicios)
frViewBarraSeleccion1: TfrViewBarraSeleccion;
- JvgWizardHeader1: TJvgWizardHeader;
EditorSeleccionActionList: TActionList;
actBuscar2: TAction;
actQuitarFiltro2: TAction;
actAnchoAuto2: TAction;
+ pnlHeader: TPanel;
+ lblTitle: TLabel;
+ lblComments: TLabel;
procedure frViewBarraSeleccion1actSeleccionarExecute(Sender: TObject);
procedure frViewBarraSeleccion1actSeleccionarUpdate(Sender: TObject);
procedure frViewBarraSeleccion1actCancelarExecute(Sender: TObject);
@@ -97,7 +99,7 @@ end;
function TfEditorElegirEjercicios.GetMensaje: String;
begin
- Result := JvgWizardHeader1.Comments.Text;
+ Result := lblComments.Caption;
end;
function TfEditorElegirEjercicios.GetMultiSelect: Boolean;
@@ -107,7 +109,7 @@ end;
procedure TfEditorElegirEjercicios.SetMensaje(const AValue: String);
begin
- JvgWizardHeader1.Comments.Text := AValue;
+ lblComments.Caption := AValue;
end;
procedure TfEditorElegirEjercicios.SetMultiSelect(AValue: Boolean);
diff --git a/Source/ApplicationBase/Empresas/Controller/uEmpresasController.pas b/Source/ApplicationBase/Empresas/Controller/uEmpresasController.pas
index d471509c..16fd050d 100644
--- a/Source/ApplicationBase/Empresas/Controller/uEmpresasController.pas
+++ b/Source/ApplicationBase/Empresas/Controller/uEmpresasController.pas
@@ -300,8 +300,6 @@ end;
function TEmpresasController.ValidarEmpresa(AEmpresa: IBizEmpresa): Boolean;
begin
- Result := False;
-
if not Assigned(AEmpresa) then
raise Exception.Create ('Empresa no asignada (ValidarEmpresa)');
diff --git a/Source/ApplicationBase/Empresas/Servidor/srvEmpresas_Impl.dfm b/Source/ApplicationBase/Empresas/Servidor/srvEmpresas_Impl.dfm
index 053ad4e6..b9263315 100644
--- a/Source/ApplicationBase/Empresas/Servidor/srvEmpresas_Impl.dfm
+++ b/Source/ApplicationBase/Empresas/Servidor/srvEmpresas_Impl.dfm
@@ -1,7 +1,6 @@
object srvEmpresas: TsrvEmpresas
OldCreateOrder = True
OnCreate = DARemoteServiceCreate
- RequiresSession = True
ConnectionName = 'IBX'
ServiceSchema = schEmpresas
ServiceDataStreamer = DABin2DataStreamer
diff --git a/Source/ApplicationBase/Empresas/Servidor/srvEmpresas_Impl.pas b/Source/ApplicationBase/Empresas/Servidor/srvEmpresas_Impl.pas
index d2c40a23..37de456b 100644
--- a/Source/ApplicationBase/Empresas/Servidor/srvEmpresas_Impl.pas
+++ b/Source/ApplicationBase/Empresas/Servidor/srvEmpresas_Impl.pas
@@ -54,7 +54,7 @@ end;
{ srvEmpresas }
procedure TsrvEmpresas.DARemoteServiceCreate(Sender: TObject);
begin
- SessionManager := dmServer.SessionManager;
+ //SessionManager := dmServer.SessionManager;
end;
function TsrvEmpresas.DarListaFormasPago: Binary;
diff --git a/Source/ApplicationBase/Usuarios/Servidor/srvUsuarios_Impl.pas b/Source/ApplicationBase/Usuarios/Servidor/srvUsuarios_Impl.pas
index 111a07c5..8b3fbc60 100644
--- a/Source/ApplicationBase/Usuarios/Servidor/srvUsuarios_Impl.pas
+++ b/Source/ApplicationBase/Usuarios/Servidor/srvUsuarios_Impl.pas
@@ -29,6 +29,7 @@ type
procedure DataAbstractServiceBeforeAcquireConnection(aSender: TObject;
var aConnectionName: string);
procedure DataAbstractServiceCreate(Sender: TObject);
+ procedure Dummy;
end;
implementation
@@ -52,7 +53,12 @@ end;
procedure TsrvUsuarios.DataAbstractServiceCreate(Sender: TObject);
begin
- SessionManager := dmServer.SessionManager;
+ //SessionManager := dmServer.SessionManager;
+end;
+
+procedure TsrvUsuarios.Dummy;
+begin
+ //
end;
initialization
diff --git a/Source/ApplicationBase/uFactuGES_App.pas b/Source/ApplicationBase/uFactuGES_App.pas
index 853dcdc8..dc568741 100644
--- a/Source/ApplicationBase/uFactuGES_App.pas
+++ b/Source/ApplicationBase/uFactuGES_App.pas
@@ -8,8 +8,7 @@ uses
uBizEmpresasTiendas;
type
- TDoLoadModulesEvent = procedure;
- TDoMainFormEvent = procedure;
+ TAppFactuGES_Event = procedure;
IAppSplashForm = interface
['{9905DF57-4476-42E6-A7CD-B1479A84E220}']
@@ -37,11 +36,14 @@ type
function GetTerminated: Boolean;
function GetConfiguracionController : IConfiguracionController;
- function GetLoadModulesEvent : TDoLoadModulesEvent;
- procedure SetLoadModulesEvent (ALoadModulesEvent : TDoLoadModulesEvent);
+ function GetLoadModulesEvent : TAppFactuGES_Event;
+ procedure SetLoadModulesEvent (ALoadModulesEvent : TAppFactuGES_Event);
- function GetDoMainFormEvent : TDoMainFormEvent;
- procedure SetDoMainFormEvent (AMainFormEvent : TDoMainFormEvent);
+ function GetDoMainFormEvent : TAppFactuGES_Event;
+ procedure SetDoMainFormEvent (AMainFormEvent : TAppFactuGES_Event);
+
+ function GetDoRefreshMainFormEvent : TAppFactuGES_Event;
+ procedure SetDoRefreshMainFormEvent (ARefreshMainFormEvent : TAppFactuGES_Event);
function GetAppSplashForm : IAppSplashForm;
procedure SetAppSplashForm (AAppSplashForm : IAppSplashForm);
@@ -71,12 +73,11 @@ type
property UsuariosController : IUsuariosController read GetUsuariosController;
property AppSplashForm : IAppSplashForm read GetAppSplashForm write SetAppSplashForm;
property ModuleManager : THostManager read GetModuleManager;
- property DoMainFormEvent : TDoMainFormEvent read GetDoMainFormEvent write SetDoMainFormEvent;
- property DoLoadModulesEvent : TDoLoadModulesEvent read GetLoadModulesEvent write SetLoadModulesEvent;
+ property DoMainFormEvent : TAppFactuGES_Event read GetDoMainFormEvent write SetDoMainFormEvent;
+ property DoLoadModulesEvent : TAppFactuGES_Event read GetLoadModulesEvent write SetLoadModulesEvent;
+ property DoRefreshMainFormEvent : TAppFactuGES_Event read GetDoRefreshMainFormEvent write SetDoRefreshMainFormEvent;
property Terminated : Boolean read GetTerminated;
property Configuracion : IConfiguracionController read GetConfiguracionController;
-
- procedure ShowCapado;
end;
@@ -93,8 +94,9 @@ type
FHostManager : THostManager;
FTerminated : Boolean;
- FDoMainFormEvent: TDoMainFormEvent;
- FDoLoadModulesEvent: TDoMainFormEvent;
+ FDoMainFormEvent: TAppFactuGES_Event;
+ FDoLoadModulesEvent: TAppFactuGES_Event;
+ FDoRefreshMainFormEvent: TAppFactuGES_Event;
function GetMainForm: TCustomForm;
function GetEmpresasController: IEmpresasController;
@@ -110,11 +112,14 @@ type
function GetTerminated: Boolean;
function GetConfiguracionController : IConfiguracionController;
- function GetLoadModulesEvent : TDoLoadModulesEvent;
- procedure SetLoadModulesEvent (ALoadModulesEvent : TDoLoadModulesEvent);
+ function GetLoadModulesEvent : TAppFactuGES_Event;
+ procedure SetLoadModulesEvent (ALoadModulesEvent : TAppFactuGES_Event);
- function GetDoMainFormEvent : TDoMainFormEvent;
- procedure SetDoMainFormEvent (AMainFormEvent : TDoMainFormEvent);
+ function GetDoMainFormEvent : TAppFactuGES_Event;
+ procedure SetDoMainFormEvent (AMainFormEvent : TAppFactuGES_Event);
+
+ function GetDoRefreshMainFormEvent : TAppFactuGES_Event;
+ procedure SetDoRefreshMainFormEvent (ARefreshMainFormEvent : TAppFactuGES_Event);
function GetAppSplashForm : IAppSplashForm;
procedure SetAppSplashForm (AAppSplashForm : IAppSplashForm);
@@ -124,7 +129,8 @@ type
procedure BuscarTiendaPorDefecto;
protected
procedure DoMainForm;
-
+ procedure DoRefreshMainForm;
+
procedure CargarModulos;
procedure ShowSplashForm;
procedure HideSplashForm;
@@ -156,12 +162,11 @@ type
property EmpresasController : IEmpresasController read GetEmpresasController;
property UsuariosController : IUsuariosController read GetUsuariosController;
property ModuleManager : THostManager read GetModuleManager;
- property DoMainFormEvent : TDoMainFormEvent read GetDoMainFormEvent write SetDoMainFormEvent;
- property DoLoadModulesEvent : TDoLoadModulesEvent read GetLoadModulesEvent write SetLoadModulesEvent;
+ property DoMainFormEvent : TAppFactuGES_Event read GetDoMainFormEvent write SetDoMainFormEvent;
+ property DoLoadModulesEvent : TAppFactuGES_Event read GetLoadModulesEvent write SetLoadModulesEvent;
+ property DoRefreshMainFormEvent : TAppFactuGES_Event read GetDoRefreshMainFormEvent write SetDoRefreshMainFormEvent;
property Terminated : Boolean read GetTerminated;
property Configuracion : IConfiguracionController read GetConfiguracionController;
-
- procedure ShowCapado;
end;
var
@@ -302,16 +307,29 @@ begin
FDoMainFormEvent();
end;
+procedure TAppFactuGES.DoRefreshMainForm;
+begin
+ if not Assigned(FDoRefreshMainFormEvent) then
+ raise Exception.Create('Evento para el refresco del formulario principal no asignado (DoRefreshMainForm)');
+
+ DoRefreshMainFormEvent();
+end;
+
function TAppFactuGES.GetMainForm: TCustomForm;
begin
Result := Application.MainForm;
end;
-function TAppFactuGES.GetDoMainFormEvent: TDoMainFormEvent;
+function TAppFactuGES.GetDoMainFormEvent: TAppFactuGES_Event;
begin
Result := FDoMainFormEvent;
end;
+function TAppFactuGES.GetDoRefreshMainFormEvent: TAppFactuGES_Event;
+begin
+ Result := FDoRefreshMainFormEvent;
+end;
+
function TAppFactuGES.GetAppFullName: String;
begin
Result := uAppInfoUtils.GetAppFullName;
@@ -355,7 +373,7 @@ begin
Result := FEmpresasController;
end;
-function TAppFactuGES.GetLoadModulesEvent: TDoLoadModulesEvent;
+function TAppFactuGES.GetLoadModulesEvent: TAppFactuGES_Event;
begin
Result := FDoLoadModulesEvent;
end;
@@ -416,6 +434,8 @@ begin
ShowSplashForm;
CargarModulos;
DoMainForm;
+ SeleccionarEmpresa;
+ DoRefreshMainForm;
finally
HideHourglassCursor;
HideSplashForm;
@@ -426,11 +446,17 @@ begin
end;
procedure TAppFactuGES.SetDoMainFormEvent(
- AMainFormEvent: TDoMainFormEvent);
+ AMainFormEvent: TAppFactuGES_Event);
begin
FDoMainFormEvent := AMainFormEvent;
end;
+procedure TAppFactuGES.SetDoRefreshMainFormEvent(
+ ARefreshMainFormEvent: TAppFactuGES_Event);
+begin
+ FDoRefreshMainFormEvent := ARefreshMainFormEvent;
+end;
+
procedure TAppFactuGES.SeleccionarEmpresa;
var
JsDialog: TJSDialog;
@@ -480,7 +506,7 @@ begin
end;
procedure TAppFactuGES.SetLoadModulesEvent(
- ALoadModulesEvent: TDoLoadModulesEvent);
+ ALoadModulesEvent: TAppFactuGES_Event);
begin
FDoLoadModulesEvent := ALoadModulesEvent;
end;
@@ -495,11 +521,6 @@ begin
FVAR_TIENDA := Avalue;
end;}
-procedure TAppFactuGES.ShowCapado;
-begin
- ShowInfoMessage('Sin Acceso', 'Funcionalidad en desarrollo, disculpen las molestias');
-end;
-
procedure TAppFactuGES.ShowSplashForm;
begin
if Assigned(FAppSplashForm) then
diff --git a/Source/Base/Base.dpk b/Source/Base/Base.dpk
index b5ee0373..7092b15e 100644
--- a/Source/Base/Base.dpk
+++ b/Source/Base/Base.dpk
@@ -30,8 +30,8 @@ requires
rtl,
vcl,
TB2k_D10,
- GUISDK_D11,
- PluginSDK_D10R,
+ GUISDK_D11R,
+ PluginSDK_D11R,
RemObjects_Core_D11,
DataAbstract_Core_D11,
vcljpg,
@@ -71,7 +71,7 @@ requires
cxLibraryD11,
dxThemeD11,
dxGDIPlusD11,
- dxNavBarD11;
+ dxNavBarD11;
contains
uDataTableUtils in 'Utiles\uDataTableUtils.pas',
diff --git a/Source/Base/Base.dproj b/Source/Base/Base.dproj
index 377a649c..6a5592b9 100644
--- a/Source/Base/Base.dproj
+++ b/Source/Base/Base.dproj
@@ -44,6 +44,13 @@
Package
FalseTrueFalseLibreria base de FactuGESFalseFalseFalseTrueFalse1000FalseFalseFalseFalseFalse308212521.0.0.01.0.0.0
+
+
+
+
+
+
+
VCL for the Web Design Package for CodeGear RAD Studio
CodeGear WebSnap Components
CodeGear SOAP Components
@@ -58,52 +65,51 @@
MainSource
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Source/Base/Base.res b/Source/Base/Base.res
index 1641339f..8b251f31 100644
Binary files a/Source/Base/Base.res and b/Source/Base/Base.res differ
diff --git a/Source/Cliente/FactuGES.dproj b/Source/Cliente/FactuGES.dproj
index 54426f6d..db2f769c 100644
--- a/Source/Cliente/FactuGES.dproj
+++ b/Source/Cliente/FactuGES.dproj
@@ -5,7 +5,7 @@
FactuGES.dpr
Debug
AnyCPU
- PluginSDK_D10R;GUISDK_D11;Base;GUIBase;ApplicationBase;vclx;vcl;rtl;vclactnband;xmlrtl;JSDialog100
+ PluginSDK_D11R;GUISDK_D11R;Base;GUIBase;ApplicationBase;vclx;vcl;rtl;vclactnband;xmlrtl;JSDialog100
DCC32
..\..\Output\Debug\Cliente\FactuGES.exe
true
@@ -57,9 +57,6 @@
- RemObjects Data Abstract - SQLite Driver
- Microsoft Office 2000 Sample Automation Server Wrapper Components
- Microsoft Office XP Sample Automation Server Wrapper Components
FactuGES.dprFalse
diff --git a/Source/Cliente/VCLFixPack.pas b/Source/Cliente/VCLFixPack.pas
new file mode 100644
index 00000000..5854f246
--- /dev/null
+++ b/Source/Cliente/VCLFixPack.pas
@@ -0,0 +1,2830 @@
+{**************************************************************************************************}
+{ }
+{ VCLFixPack unit - Unoffical bug fixes for Delphi/C++Builder }
+{ Version 1.2 (2009-03-03) }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is VCLFixPack.pas. }
+{ }
+{ The Initial Developer of the Original Code is Andreas Hausladen (Andreas.Hausladen@gmx.de). }
+{ Portions created by Andreas Hausladen are Copyright (C) 2008 Andreas Hausladen. }
+{ All Rights Reserved. }
+{ }
+{**************************************************************************************************}
+
+{$IFNDEF CONDITIONALEXPRESSIONS}
+ Delphi5_is_not_supported
+{$ENDIF}
+
+{$A8,B-,C+,D-,E-,F-,G+,H+,I+,J-,K-,L+,M-,N-,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
+
+{ If you define VCLFIXPACK_DEBUG the patches are compiled with debug information. }
+{$IFDEF VCLFIXPACK_DEBUG} {$D+} {$ENDIF}
+
+{ If you use Delphi 6/7/2005 Personal you must disable the VCLFIXPACK_DB_SUPPORT define. }
+{$DEFINE VCLFIXPACK_DB_SUPPORT}
+
+unit VCLFixPack;
+
+{
+ Usage
+ =====
+ Add the unit to the .dpr file's uses-list.
+ C++Builder user can add the file to the project (Menu Project/Add to project)
+
+ Example
+ =======
+ uses
+ FastMM4, // optional memory manager
+ VCLFixPack,
+ Forms,
+ Unit1 in 'Unit1.pas';
+
+
+ Fixes the following bug
+ =======================
+ - [2006-2009]
+ QC #68647: Infinite loop in Forms.GetNonToolWindowPopupParent
+ (http://qc.codegear.com/wc/qcmain.aspx?d=68647)
+
+ - [2007-2009]
+ QC #68740: Lost focus after TOpenDialog when MainFormOnTaskBar is set
+ (http://qc.codegear.com/wc/qcmain.aspx?d=68740)
+
+ - [2005-2009]
+ QC #59963: Closing non-modal forms after a task switch can deactivate the application
+ (http://qc.codegear.com/wc/qcmain.aspx?d=59963)
+
+ - [2009]
+ QC #66892: Closing forms deactivates the application (missing "stdcall")
+ (http://qc.codegear.com/wc/qcmain.aspx?d=66892)
+
+ - [6-2007]
+ Control resize bugfix for kernel stack overflow due to WH_CALLWNDPROC hook
+
+ - [6-2007]
+ QC #59654: TActionList access already released FActions field
+ (http://qc.codegear.com/wc/qcmain.aspx?d=59654)
+
+ - [6-2007]
+ QC #54286 : Parent-PopupMenu overrides standard context menu (edit, memo, combobox, ...)
+ (http://qc.codegear.com/wc/qcmain.aspx?d=54286)
+
+ - [2006-2007]
+ QC #50097: ObjAuto access violation on XEON (Data Execution Prevention bug)
+ (http://qc.codegear.com/wc/qcmain.aspx?d=50097)
+
+ - [6-2009]
+ Classes.MakeObjectInstance memory leak fix
+ (for usage in a DLL)
+
+ - [2007]
+ QC #58938: MainForm Minimize minimizes in the background
+ (http://qc.codegear.com/wc/qcmain.aspx?d=58938)
+
+ - [6-2009]
+ QC #64484: SysUtils.Abort can raise an AccessViolation
+ (http://qc.codegear.com/wc/qcmain.aspx?d=64484)
+
+ - [2007]
+ QC #58939: No taskbar button when starting from ShellLink with Show=Minimized
+ (http://qc.codegear.com/wc/qcmain.aspx?d=58939)
+
+ - [6-2009]
+ QC #35001: MDIChild's active control focus is not set correctly
+ (http://qc.codegear.com/wc/qcmain.aspx?d=35001)
+
+ - [7-2009]
+ QC #56252: TPageControl flickers a lot with active theming
+ (http://qc.codegear.com/wc/qcmain.aspx?d=56252)
+ QC #68730: TLabel is not painted on a themed, double-buffered TTabSheet in Vista
+ (http://qc.codegear.com/wc/qcmain.aspx?d=68730)
+ TLabels on TTabSheet are not painted (themes) if a TWinControl like TMemo is on the TTabSheet (TWinControl.PaintWindow bug)
+
+ - [7-2009]
+ Grid flickers with active theming (DBGrid, StringGrid and DrawGrid only, no derived classes)
+
+ - [2009]
+ QC #69112: TSpeedButton is painted as a black rectangle on a double buffered panel on a sheet of glass.
+
+ - [2009]
+ QC #69294: TProgressBar fails with PBS_MARQUEE and disabled Themes (Vista)
+ http://qc.codegear.com/wc/qcmain.aspx?d=69294
+
+ - [Windows Vista]
+ Workaround for Windows Vista CompareString bug
+ (Workaround is disabled by default, define "VistaCompareStringFix" to activate it)
+
+ - [2007-2009]
+ QC #52439: DbNavigator paints incorrectly when flat=true in themed mode
+
+ - [2009]
+ QC #70441: ToUpper and ToLower modify a Const argument
+
+ - [2009]
+ QC #69752: ToUpper and ToLower with NullString
+
+ - [2009]
+ QC #69875: StringBuilder.Replace is incorrect
+ QC #67564: Error in TStringBuilder.Replace
+
+
+ Changlog:
+ 2009-03-03:
+ Fixed: Rewritten patch for QC #59963 (AppDeActivateZOrderFix) to fix the cause instead of the symptom
+ Added: QC #52439: DbNavigator paints incorrectly when flat=true in themed mode
+ Added: QC #70441: ToUpper and ToLower modify a Const argument
+ Added: QC #69752: ToUpper and ToLower with NullString
+ Added: QC #69875, #67564: StringBuilder.Replace is incorrect
+ + a much faster implementation
+
+ 2009-01-25:
+ Fixed: DBGrid ScrollBar gab wasn't painted correctly in BiDiMode <> bdLeftToRight
+ Fixed: TTabSheet could throw an access violation if no PageControl was assigned to it
+ Changed: Rewritten TaskModalDialog bugfix
+ Added: QC #69294: TProgressBar fails with PBS_MARQUEE and disabled Themes (Vista)
+
+}
+
+interface
+
+{ ---------------------------------------------------------------------------- }
+
+{$DEFINE DBTextColorBugFix} // Delphi 6+
+
+{$IF CompilerVersion >= 18.0} // Delphi 2006+
+ {$DEFINE GetNonToolWindowPopupParentFix}
+{$IFEND}
+
+{$IF CompilerVersion >= 18.5} // Delphi 2007+
+ {$DEFINE TaskModalDialogFix}
+{$IFEND}
+
+{$IF CompilerVersion >= 16.0} // Delphi 2005
+ {$DEFINE AppDeActivateZOrderFix}
+{$IFEND}
+
+{$IF CompilerVersion = 20.0} // Delphi 2009
+ {$DEFINE HideStackTrashingFix}
+{$IFEND}
+
+{$IF CompilerVersion < 20.0} // Delphi 6-2007
+ {$DEFINE ControlResizeFix}
+ { The OPTIMIZED_RESIZE_REDRAW option is experimental. It speeds up the resizing of forms
+ by not redrawing each control when it is realigned but by invalidating them all after
+ one align round is done. }
+ {.$DEFINE OPTIMIZED_RESIZE_REDRAW}
+{$IFEND}
+
+{$IF CompilerVersion < 20.0} // Delphi 6-2007
+ {$DEFINE ActionListAVFix}
+{$IFEND}
+
+{$IF CompilerVersion < 20.0} // Delphi 6-2007
+ {$DEFINE ContextMenuFix}
+{$IFEND}
+
+{$IF (CompilerVersion >= 18.0) and (CompilerVersion < 20.0)} // Delphi 2006-2007
+ {$DEFINE ObjAutoDEPFix}
+{$IFEND}
+
+{$DEFINE MkObjInstLeakFix} // Delphi 6+
+
+{$DEFINE SysUtilsAbortFix} // Delphi 6+
+
+{$IF CompilerVersion = 18.5} // Delphi 2007
+ {$DEFINE AppMinimizeFix}
+{$IFEND}
+
+{$IF CompilerVersion = 18.5} // Delphi 2007
+ {$DEFINE CmdShowMinimizeFix}
+{$IFEND}
+
+{$DEFINE MDIChildFocusFix} // Delphi 6+
+
+{$IF CompilerVersion >= 15} // Delphi 7+
+ {$DEFINE PageControlPaintingFix}
+{$IFEND}
+
+{$IF CompilerVersion >= 15} // Delphi 7+
+ {$DEFINE GridFlickerFix}
+{$IFEND}
+
+{$IF CompilerVersion = 20.0} // Delphi 2009
+ {$DEFINE SpeedButtonGlassFix}
+{$IFEND}
+
+{$IF CompilerVersion = 20.0} // Delphi 2009
+ {$DEFINE VistaProgressBarMarqueeFix}
+{$IFEND}
+
+{$IF CompilerVersion = 20.0} // Delphi 2009
+ {$DEFINE CharacterFix}
+{$IFEND}
+
+{$IF CompilerVersion = 20.0} // Delphi 2009
+ {$DEFINE StringBuilderFix}
+{$IFEND}
+
+{$IF (CompilerVersion >= 18.5) and (CompilerVersion <= 20.0)} // Delphi 2007-2009
+ {$IFDEF VCLFIXPACK_DB_SUPPORT}
+ {$DEFINE DBNavigatorFix}
+ {$ENDIF VCLFIXPACK_DB_SUPPORT}
+{$IFEND}
+
+{**************************************************************************************************}
+{ Workaround for Windows Vista CompareString bug. }
+{ The Ü/ü ($DC/$FC) and the UE/ue are treated equal in all locales, but they aren't equal. There }
+{ was a bugfix intended for Vista SP1 but it was removed before SP1 was released. }
+{ Windows 2008 Server still includes this bugfix but Vista will never get this bugfix. }
+{ Microsoft: new versions are for correctness; service packs are for consistency and compatibility }
+{**************************************************************************************************}
+{ WARNING: This bugfix can slow down CompareString }
+{.$DEFINE VistaCompareStringFix}
+
+
+implementation
+
+{$IF CompilerVersion >= 18.0}
+ {$DEFINE DELPHI2006_UP}
+{$IFEND}
+{$IF CompilerVersion >= 17.0}
+ {$DEFINE DELPHI2005_UP}
+{$IFEND}
+
+uses
+ Windows, Messages, SysUtils, Classes, TypInfo, ActnList, SysConst,
+ {$IFDEF ObjAutoDEPFix}
+ ObjAuto,
+ {$ENDIF ObjAutoDEPFix}
+ {$IF CompilerVersion >= 15.0}
+ Themes,
+ {$IFEND}
+ {$IF CompilerVersion >= 20.0}
+ Character,
+ {$IFEND}
+ {$IFDEF VCLFIXPACK_DB_SUPPORT}
+ DBGrids, DBCtrls,
+ {$ENDIF VCLFIXPACK_DB_SUPPORT}
+ Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, ComCtrls, Buttons,
+ CommCtrl;
+
+{ ---------------------------------------------------------------------------- }
+{ Helper functions, shared }
+type
+ TOpenWinControl = class(TWinControl);
+ TOpenCustomForm = class(TCustomForm);
+ TOpenCommonDialog = class(TCommonDialog);
+ TOpenCustomActionList = class(TCustomActionList);
+ TOpenComponent = class(TComponent);
+ TOpenCustomCombo = class(TCustomCombo);
+
+ TJumpOfs = Integer;
+ PPointer = ^Pointer;
+
+type
+ PXRedirCode = ^TXRedirCode;
+ TXRedirCode = packed record
+ Jump: Byte;
+ Offset: TJumpOfs;
+ end;
+
+ PWin9xDebugThunk = ^TWin9xDebugThunk;
+ TWin9xDebugThunk = packed record
+ PUSH: Byte;
+ Addr: Pointer;
+ JMP: TXRedirCode;
+ end;
+
+ PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
+ TAbsoluteIndirectJmp = packed record
+ OpCode: Word; //$FF25(Jmp, FF /4)
+ Addr: PPointer;
+ end;
+
+var
+ TaskActiveWindow: HWND;
+ TaskFirstWindow: HWND;
+ TaskFirstTopMost: HWND;
+
+function DoFindWindow(Window: HWND; Param: LPARAM): Bool; stdcall;
+begin
+ if (Window <> TaskActiveWindow) and (Window <> Application.Handle) and
+ IsWindowVisible(Window) and IsWindowEnabled(Window) then
+ begin
+ if GetWindowLong(Window, GWL_EXSTYLE) and WS_EX_TOPMOST = 0 then
+ begin
+ if TaskFirstWindow = 0 then
+ TaskFirstWindow := Window;
+ end else
+ begin
+ if TaskFirstTopMost = 0 then
+ TaskFirstTopMost := Window;
+ end;
+ end;
+ Result := True;
+end;
+
+function FindTopMostWindow(ActiveWindow: HWND): HWND;
+begin
+ TaskActiveWindow := ActiveWindow;
+ TaskFirstWindow := 0;
+ TaskFirstTopMost := 0;
+ EnumThreadWindows(GetCurrentThreadID, @DoFindWindow, 0);
+ if TaskFirstWindow <> 0 then
+ Result := TaskFirstWindow
+ else
+ Result := TaskFirstTopMost;
+end;
+
+{ Hooking }
+
+function GetActualAddr(Proc: Pointer): Pointer;
+
+ function IsWin9xDebugThunk(AAddr: Pointer): Boolean;
+ begin
+ Result := (AAddr <> nil) and
+ (PWin9xDebugThunk(AAddr).PUSH = $68) and
+ (PWin9xDebugThunk(AAddr).JMP.Jump = $E9);
+ end;
+
+begin
+ if Proc <> nil then
+ begin
+ if (Win32Platform <> VER_PLATFORM_WIN32_NT) and IsWin9xDebugThunk(Proc) then
+ Proc := PWin9xDebugThunk(Proc).Addr;
+ if (PAbsoluteIndirectJmp(Proc).OpCode = $25FF) then
+ Result := PAbsoluteIndirectJmp(Proc).Addr^
+ else
+ Result := Proc;
+ end
+ else
+ Result := nil;
+end;
+
+procedure HookProc(Proc, Dest: Pointer; var BackupCode: TXRedirCode);
+var
+ n: DWORD;
+ Code: TXRedirCode;
+begin
+ Proc := GetActualAddr(Proc);
+ Assert(Proc <> nil);
+ if ReadProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n) then
+ begin
+ Code.Jump := $E9;
+ Code.Offset := PAnsiChar(Dest) - PAnsiChar(Proc) - SizeOf(Code);
+ WriteProcessMemory(GetCurrentProcess, Proc, @Code, SizeOf(Code), n);
+ end;
+end;
+
+procedure UnhookProc(Proc: Pointer; var BackupCode: TXRedirCode);
+var
+ n: Cardinal;
+begin
+ if (BackupCode.Jump <> 0) and (Proc <> nil) then
+ begin
+ Proc := GetActualAddr(Proc);
+ Assert(Proc <> nil);
+ WriteProcessMemory(GetCurrentProcess, Proc, @BackupCode, SizeOf(BackupCode), n);
+ BackupCode.Jump := 0;
+ end;
+end;
+
+procedure ReplaceVmtField(AClass: TClass; OldProc, NewProc: Pointer);
+type
+ PVmt = ^TVmt;
+ TVmt = array[0..MaxInt div SizeOf(Pointer) - 1] of Pointer;
+var
+ I: Integer;
+ Vmt: PVmt;
+ n: Cardinal;
+ P: Pointer;
+begin
+ OldProc := GetActualAddr(OldProc);
+ NewProc := GetActualAddr(NewProc);
+
+ I := vmtSelfPtr div SizeOf(Pointer);
+ Vmt := Pointer(AClass);
+ while (I < 0) or (Vmt[I] <> nil) do
+ begin
+ P := Vmt[I];
+ if (P <> OldProc) and (Integer(P) > $10000) and not IsBadReadPtr(P, 6) then
+ P := GetActualAddr(P);
+ if P = OldProc then
+ begin
+ WriteProcessMemory(GetCurrentProcess, @Vmt[I], @NewProc, SizeOf(NewProc), n);
+ Exit;
+ end;
+ Inc(I);
+ end;
+end;
+
+function GetDynamicMethod(AClass: TClass; Index: Integer): Pointer;
+asm
+ call System.@FindDynaClass
+end;
+
+procedure DebugLog(const S: string);
+begin
+ OutputDebugString(PChar('VCLFixPack patch installed: ' + S));
+end;
+{ ---------------------------------------------------------------------------- }
+
+
+
+{ ---------------------------------------------------------------------------- }
+{ QC #68647: Infinite loop in Forms.GetNonToolWindowPopupParent }
+{$IFDEF GetNonToolWindowPopupParentFix}
+{
+Forms.pas.4712: Result := GetParent(WndParent); <= must be "Result := GetParent(Result);"
+56 push esi <= must be "push ebx"
+E8181EFAFF call GetParent
+8BD8 mov ebx,eax
+Forms.pas.4711: while (Result <> 0) and (GetWindowLong(Result, GWL_EXSTYLE) and WS_EX_TOOLWINDOW = WS_EX_TOOLWINDOW) do
+85DB test ebx,ebx
+}
+procedure FixGetNonToolWindowPopupParent;
+var
+ P: PAnsiChar;
+ Len: Integer;
+ Buf: Byte;
+ n: Cardinal;
+begin
+ P := GetActualAddr(@TOpenCustomForm.CreateParams);
+ Dec(P);
+ Len := 0;
+ while Len < 112 do
+ begin
+ if //(P[0] = #$56) and // push esi
+ (P[1] = #$E8) and // call GetParent
+ (P[6] = #$8B) and (P[7] = #$D8) and // mov ebx,eax
+ (P[8] = #$85) and (P[9] = #$DB) then // test ebx,ebx
+ begin
+ if P[0] = #$56 then // push esi
+ begin
+ Buf := $53; // push esi (WndParent) => push ebx (Result)
+ WriteProcessMemory(GetCurrentProcess, P, @Buf, 1, n);
+ DebugLog('GetNonToolWindowPopupParentFix');
+ Exit;
+ end else
+ if P[0] = #$53 then // push ebx => already fixed, abort search
+ Exit;
+ end;
+ Dec(P);
+ Inc(Len);
+ end;
+end;
+{$ENDIF GetNonToolWindowPopupParentFix}
+{ ---------------------------------------------------------------------------- }
+
+
+
+{ ---------------------------------------------------------------------------- }
+{ QC #68740: Lost focus after TOpenDialog when MainFormOnTaskBar is set }
+{$IFDEF TaskModalDialogFix}
+var
+ DialogsTaskModalDialogHook: TXRedirCode;
+ DialogsTaskModalDialogCritSect: TRTLCriticalSection;
+
+function TCommonDialog_TaskModalDialog(Instance: TObject; DialogFunc: Pointer; var DialogData): Bool;
+var
+ FocusWindow: HWND;
+ Func: function(Instance: TObject; DialogFunc: Pointer; var DialogData): Bool;
+begin
+ EnterCriticalSection(DialogsTaskModalDialogCritSect);
+ try
+ UnhookProc(@TOpenCommonDialog.TaskModalDialog, DialogsTaskModalDialogHook);
+ try
+ FocusWindow := GetFocus;
+ try
+ Func := @TOpenCommonDialog.TaskModalDialog;
+ Result := Func(Instance, DialogFunc, DialogData);
+ finally
+ SetFocus(FocusWindow);
+ end;
+ finally
+ HookProc(@TOpenCommonDialog.TaskModalDialog, @TCommonDialog_TaskModalDialog, DialogsTaskModalDialogHook);
+ end;
+ finally
+ LeaveCriticalSection(DialogsTaskModalDialogCritSect);
+ end;
+end;
+
+procedure InitTaskModalDialogFix;
+begin
+ InitializeCriticalSection(DialogsTaskModalDialogCritSect);
+ HookProc(@TOpenCommonDialog.TaskModalDialog, @TCommonDialog_TaskModalDialog, DialogsTaskModalDialogHook);
+ DebugLog('FixTaskModalDialog');
+end;
+
+procedure FiniTaskModalDialogFix;
+begin
+ UnhookProc(@TOpenCommonDialog.TaskModalDialog, DialogsTaskModalDialogHook);
+ DeleteCriticalSection(DialogsTaskModalDialogCritSect);
+end;
+{$ENDIF TaskModalDialogFix}
+{ ---------------------------------------------------------------------------- }
+
+
+
+{ ---------------------------------------------------------------------------- }
+{ QC #59963: Closing non-modal forms after a task switch can deactivate the application }
+{$IFDEF AppDeActivateZOrderFix}
+{
+// Release
+0047B1FD F6401C08 test byte ptr [eax+$1c],$08
+0047B201 7522 jnz $0047b225 << replace by $90 $90 => nop nop
+0047B203 8BC3 mov eax,ebx
+0047B205 8B150C824500 mov edx,[$0045820c]
+0047B20B E85C8BF8FF call @IsClass
+0047B210 84C0 test al,al
+0047B212 7509 jnz $0047b21d
+0047B214 83BBCC01000000 cmp dword ptr [ebx+$000001cc],$00
+0047B21B 7408 jz $0047b225
+0047B21D 8B45FC mov eax,[ebp-$04]
+0047B220 E8DFFDFFFF call TWinControl.UpdateShowing
+0047B225 5E pop esi
+0047B226 5B pop ebx
+0047B227 59 pop ecx
+0047B228 5D pop ebp
+0047B229 C3 ret
+}
+
+procedure InitAppDeActivateZOrderFix;
+var
+ P: PAnsiChar;
+ Len: Integer;
+ Buf: Word;
+ n: Cardinal;
+begin
+ P := GetActualAddr(@TWinControl.UpdateControlState);
+ Len := 0;
+ while Len < 200 do
+ begin
+ if (P[0] = #$F6) and (P[1] = #$40) and (P[2] = #$1C) and (P[3] = #$08) and // test byte ptr [eax+$1c],$08
+ (P[4] = #$75) and (P[5] = #$22) and // jnz +$22
+ (P[6] = #$8B) and (P[7] = #$C3) and // mov eax,ebx
+ (P[8] = #$8B) then // mov edx,[TCustomForm]
+ begin
+ Buf := $9090; // nop nop
+ WriteProcessMemory(GetCurrentProcess, @P[4], @Buf, SizeOf(Buf), n);
+ DebugLog('AppDeActivateZOrderFix');
+ Exit;
+ end
+ else
+ if (P[0] = #$59) and (P[0] = #$5D) and (P[1] = #$C3) then // function end reached
+ Break;
+
+ Inc(P);
+ Inc(Len);
+ end;
+end;
+
+procedure FiniAppDeActivateZOrderFix;
+begin
+end;
+
+{$ENDIF AppDeActivateZOrderFix}
+{ ---------------------------------------------------------------------------- }
+
+
+
+{ ---------------------------------------------------------------------------- }
+{ QC #66892: Closing forms deactivates the application (missing "stdcall") }
+{$IFDEF HideStackTrashingFix}
+var
+ FindTopMostWindowHook: TXRedirCode;
+ FindTopMostWindowProc: Pointer;
+
+{
+Forms.pas.1880: begin
+53 push ebx
+Forms.pas.1881: TaskActiveWindow := ActiveWindow;
+A3D8784700 mov [$004778d8],eax
+Forms.pas.1882: TaskFirstWindow := 0;
+33C0 xor eax,eax
+A3DC784700 mov [$004778dc],eax
+Forms.pas.1883: TaskFirstTopMost := 0;
+33C0 xor eax,eax
+A3E0784700 mov [$004778e0],eax
+Forms.pas.1884: EnumProc := @DoFindWindow;
+BBBCB64500 mov ebx,$0045b6bc
+Forms.pas.1885: EnumThreadWindows(GetCurrentThreadID, EnumProc, 0);
+6A00 push $00
+53 push ebx
+E8DBCBFAFF call GetCurrentThreadId
+50 push eax
+E821D1FAFF call EnumThreadWindows
+
+}
+function GetAddrOfFindTopMostWindow: Pointer;
+var
+ P: PByte;
+ Len: Integer;
+ NeedsFix: Boolean;
+begin
+ NeedsFix := False;
+ P := GetActualAddr(@EnableTaskWindows);
+ Len := 0;
+ while Len < 2048 do
+ begin
+ { DoFindWindow "begin" }
+ if (P[0] = $53) and
+ (P[1] = $8B) and (P[2] = $D8) then
+ begin
+ if (P[3] = $3B) and (P[4] = $1D) and
+ (P[9] = $74) and ({Release}(P[10] = $4D) or {Debug}(P[10] = $4F)) then
+ begin
+ NeedsFix := True;
+ end
+ end
+ else { FindTopMostWindow "begin", Release & Debug }
+ if (P[0] = $53) and
+ (P[1] = $A3) then
+ begin
+ if (P[6] = $33) and (P[7] = $C0) and
+ (P[8] = $A3) and
+ (P[13] = $33) and (P[14] = $C0) and
+ (P[15] = $A3) and
+ (P[20] = $BB) and
+ (P[25] = $6A) and (P[26] = $00) and
+ (P[27] = $53) then
+ begin
+ Result := nil;
+ if NeedsFix then
+ Result := P;
+ Exit;
+ end;
+ end;
+ Inc(P);
+ Inc(Len);
+ end;
+ Result := nil;
+end;
+{$ENDIF HideStackTrashingFix}
+{ ---------------------------------------------------------------------------- }
+
+
+
+{ ---------------------------------------------------------------------------- }
+{ Control resize bugfix for kernel stack overflow due to WH_CALLWNDPROC hook }
+{$IFDEF ControlResizeFix}
+{2008-05-25:
+ - Added code to detect endless resizing controls.
+ - Added experimental OPTIMIZED_RESIZE_REDRAW option for faster form resizing }
+var
+ WinControl_AlignControlProc, WinControl_WMSize, WinControl_SetBounds: Pointer;
+ BackupAlignControl, BackupWMSize, BackupSetBounds: TXRedirCode;
+
+type
+ TControlResizeFixWinControl = class(TWinControl)
+ private
+ procedure AlignControl(AControl: TControl);
+ procedure HandleAlignControls(AControl: TControl; var R: TRect);
+ protected
+ procedure WMSize(var Message: TWMSize); message WM_SIZE;
+ procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
+ end;
+
+ {$IFNDEF DELPHI2005_UP}
+ TD5WinControlPrivate = class(TControl)
+ public
+ FAlignLevel: Word;
+ end;
+ {$ENDIF ~DELPHI2005_UP}
+
+threadvar
+ AlignControlList: TList;
+
+procedure TControlResizeFixWinControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
+var
+ WindowPlacement: TWindowPlacement;
+begin
+ if (ALeft <> Left) or (ATop <> Top) or
+ (AWidth <> Width) or (AHeight <> Height) then
+ begin
+ if HandleAllocated and not IsIconic(WindowHandle) then
+ begin
+ if AlignControlList <> nil then
+ SetWindowPos(WindowHandle, 0, ALeft, ATop, AWidth, AHeight,
+ SWP_NOZORDER or SWP_NOACTIVATE or SWP_DEFERERASE)
+ else
+ SetWindowPos(WindowHandle, 0, ALeft, ATop, AWidth, AHeight,
+ SWP_NOZORDER or SWP_NOACTIVATE);
+ end
+ else
+ begin
+ PInteger(@Left)^ := ALeft;
+ PInteger(@Top)^ := ATop;
+ PInteger(@Width)^ := AWidth;
+ PInteger(@Height)^ := AHeight;
+ if HandleAllocated then
+ begin
+ WindowPlacement.Length := SizeOf(WindowPlacement);
+ GetWindowPlacement(WindowHandle, @WindowPlacement);
+ WindowPlacement.rcNormalPosition := BoundsRect;
+ SetWindowPlacement(WindowHandle, @WindowPlacement);
+ end;
+ end;
+ UpdateBoundsRect(Rect(Left, Top, Left + Width, Top + Height));
+ RequestAlign;
+ end;
+end;
+
+procedure TControlResizeFixWinControl.HandleAlignControls(AControl: TControl; var R: TRect);
+
+ function AlignWork: Boolean;
+ var
+ I: Integer;
+ begin
+ Result := True;
+ for I := ControlCount - 1 downto 0 do
+ if (Controls[I].Align <> alNone) or
+ (Controls[I].Anchors <> [akLeft, akTop]) then
+ Exit;
+ Result := False;
+ end;
+
+var
+ OwnAlignControlList, TempAlignControlList: TList;
+ ResizeList: TList;
+ ResizeCounts: TList; // of Integer
+ Ctrl: TWinControl;
+ I, Index: Integer;
+begin
+ if AlignWork then
+ begin
+ OwnAlignControlList := nil;
+ try
+ if AlignControlList = nil then
+ begin
+ OwnAlignControlList := TList.Create;
+ AlignControlList := OwnAlignControlList;
+ end;
+
+ AlignControls(AControl, R);
+
+ if (OwnAlignControlList <> nil) and (OwnAlignControlList.Count > 0) then
+ begin
+ { Convert recursion into an iteration to prevent the kernel stack overflow }
+ ResizeList := TList.Create;
+ ResizeCounts := TList.Create;
+ try
+ { The controls in the OwnAlignControlList must be added to ResizeList in reverse order.
+ Otherwise the OnResize events aren't fired in correct order. }
+ AlignControlList := TList.Create;
+ try
+ repeat
+ try
+ for I := OwnAlignControlList.Count - 1 downto 0 do
+ begin
+ Ctrl := TWinControl(OwnAlignControlList[I]);
+ Index := ResizeList.IndexOf(Ctrl);
+
+ { An endless resizing component was stopped by the kernel stack overflow bug.
+ So we must catch this condition to prevent an endless loop. }
+ if (Index = -1) or (Integer(ResizeCounts[Index]) < 30) then
+ begin
+ Ctrl.Realign;
+
+ if Index <> -1 then
+ ResizeCounts[Index] := Pointer(Integer(ResizeCounts[Index]) + 1);
+ ResizeCounts.Add(Pointer(0)); // keep index in sync
+ ResizeList.Add(Ctrl);
+ end
+ else if Index <> -1 then
+ begin
+ {$WARNINGS OFF}
+ if DebugHook <> 0 then
+ {$WARNINGS ON}
+ OutputDebugString(PChar(Format('The component "%s" of class %s has an endless resize loop', [Ctrl.Name, Ctrl.ClassName])));
+ end;
+ end;
+ finally
+ OwnAlignControlList.Clear;
+
+ { Switch lists }
+ TempAlignControlList := AlignControlList;
+ AlignControlList := OwnAlignControlList;
+ OwnAlignControlList := TempAlignControlList;
+ end;
+ until (OwnAlignControlList.Count = 0) {or EndlessResizeDetection};
+ finally
+ { Let another AlignControlList handle any alignment that comes from the
+ OnResize method. }
+ FreeAndNil(AlignControlList);
+ end;
+
+ { Fire Resize events }
+ for I := ResizeList.Count - 1 downto 0 do
+ begin
+ Ctrl := TWinControl(ResizeList[I]);
+ if not (csLoading in Ctrl.ComponentState) then
+ TOpenWinControl(Ctrl).Resize;
+ end;
+ finally
+ ResizeCounts.Free;
+ ResizeList.Free;
+ end;
+ {$IFDEF OPTIMIZED_RESIZE_REDRAW}
+ Invalidate;
+ {$ENDIF OPTIMIZED_RESIZE_REDRAW}
+ end;
+ finally
+ if OwnAlignControlList <> nil then
+ begin
+ AlignControlList := nil;
+ FreeAndNil(OwnAlignControlList);
+ end;
+ end;
+ end
+ else
+ AlignControls(AControl, R);
+end;
+
+procedure TControlResizeFixWinControl.WMSize(var Message: TWMSize);
+begin
+ {$IFDEF DELPHI2005_UP}
+ UpdateBounds;
+ {$IFDEF DELPHI2006_UP}
+ UpdateExplicitBounds;
+ {$ENDIF DELPHI2006_UP}
+ {$ELSE}
+ if HandleAllocated then
+ Perform(WM_MOVE, 0, LPARAM(Left and $0000ffff) or (Top shl 16)); // calls the private UpdateBounds
+ {$ENDIF DELPHI2005_UP}
+ DefaultHandler(Message);
+ if AlignControlList <> nil then
+ begin
+ if AlignControlList.IndexOf(Self) = -1 then
+ AlignControlList.Add(Self)
+ end
+ else
+ begin
+ Realign;
+ if not (csLoading in ComponentState) then
+ Resize;
+ end;
+end;
+
+procedure TControlResizeFixWinControl.AlignControl(AControl: TControl);
+var
+ Rect: TRect;
+begin
+ if not HandleAllocated or (csDestroying in ComponentState) then
+ Exit;
+ {$IFDEF DELPHI2005_UP}
+ if AlignDisabled then
+ {$ELSE}
+ if TD5WinControlPrivate(Self).FAlignLevel <> 0 then
+ {$ENDIF DELPHI2005_UP}
+ ControlState := ControlState + [csAlignmentNeeded]
+ else
+ begin
+ DisableAlign;
+ try
+ Rect := GetClientRect;
+
+ HandleAlignControls(AControl, Rect);
+ finally
+ ControlState := ControlState - [csAlignmentNeeded];
+ EnableAlign;
+ end;
+ end;
+end;
+
+function GetAlignControlProc: Pointer;
+var
+ P: PByteArray;
+ Offset: Integer;
+ MemInfo: TMemoryBasicInformation;
+begin
+ P := GetActualAddr(@TWinControl.Realign);
+ if (P <> nil) and (VirtualQuery(P, MemInfo, SizeOf(MemInfo)) = SizeOf(MemInfo)) then
+ begin
+ if (MemInfo.AllocationProtect <> PAGE_NOACCESS) then
+ begin
+ Offset := 0;
+ while Offset < $40 do
+ begin
+ if ((P[0] = $33) and (P[1] = $D2)) or // xor edx,edx
+ ((P[0] = $31) and (P[1] = $D2)) then // xor edx,edx
+ begin
+ if P[2] = $E8 then // call TWinControl.AlignControl
+ begin
+ Inc(PByte(P), 2);
+ Result := PAnsiChar(P) + 5 + PInteger(PAnsiChar(P) + 1)^;
+ Exit;
+ end
+ else if (P[2] = $8B) and (P[3] = $45) and (P[4] = $FC) and // mov eax,[ebp-$04]
+ (P[5] = $E8) then // call TWinControl.AlignControl
+ begin
+ Inc(PByte(P), 5);
+ Result := PAnsiChar(P) + 5 + PInteger(PAnsiChar(P) + 1)^;
+ Exit;
+ end;
+ end;
+ Inc(PByte(P));
+ Inc(Offset);
+ end;
+ end;
+ end;
+ Result := nil;
+end;
+
+procedure InitControlResizeFix;
+begin
+ WinControl_AlignControlProc := GetAlignControlProc;
+ WinControl_WMSize := GetDynamicMethod(TWinControl, WM_SIZE);
+ WinControl_SetBounds := @TOpenWinControl.SetBounds;
+ if (WinControl_AlignControlProc <> nil) and (WinControl_WMSize <> nil) then
+ begin
+ DebugLog('ControlResizeFix');
+ { Redirect the original function to the bug fixed version }
+ HookProc(WinControl_AlignControlProc, @TControlResizeFixWinControl.AlignControl, BackupAlignControl);
+ HookProc(WinControl_WMSize, @TControlResizeFixWinControl.WMSize, BackupWMSize);
+ {$IFDEF OPTIMIZED_RESIZE_REDRAW}
+ HookProc(WinControl_SetBounds, @TControlResizeFixWinControl.SetBounds, BackupSetBounds);
+ {$ENDIF OPTIMIZED_RESIZE_REDRAW}
+ end;
+end;
+
+procedure FiniControlResizeFix;
+begin
+ { Restore the original function }
+ UnhookProc(WinControl_AlignControlProc, BackupAlignControl);
+ UnhookProc(WinControl_WMSize, BackupWMSize);
+ UnhookProc(WinControl_SetBounds, BackupSetBounds);
+end;
+
+{$ENDIF ControlResizeFix}
+{ ---------------------------------------------------------------------------- }
+
+
+
+{ ---------------------------------------------------------------------------- }
+{ QC #59654: TActionList access already released FActions field }
+{$IFDEF ActionListAVFix}
+var
+ HookTCustomActionList_Notification: TXRedirCode;
+
+type
+ TCustomActionListFix = class(TCustomActionList)
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ end;
+
+procedure TCustomActionListFix.Notification(AComponent: TComponent; Operation: TOperation);
+var
+ P: procedure(Instance: TComponent; AComponent: TComponent; Operation: TOperation);
+begin
+ { inherited: }
+ P := @TOpenComponent.Notification;
+ P(Self, AComponent, Operation);
+
+ if Operation = opRemove then
+ begin
+ if AComponent = Images then
+ Images := nil
+ else if {<*}not (csDestroying in ComponentState) and{*>} (AComponent is TContainedAction) then
+ RemoveAction(TContainedAction(AComponent));
+ end;
+end;
+
+procedure InitActionListAVFix;
+begin
+ DebugLog('ActionListAVFix');
+ HookProc(@TOpenCustomActionList.Notification, @TCustomActionListFix.Notification, HookTCustomActionList_Notification);
+end;
+
+procedure FiniActionListAVFix;
+begin
+ UnhookProc(@TOpenCustomActionList.Notification, HookTCustomActionList_Notification);
+end;
+{$ENDIF ActionListAVFix}
+{ ---------------------------------------------------------------------------- }
+
+
+
+{ ---------------------------------------------------------------------------- }
+{ QC #54286 : Parent-PopupMenu overrides standard context menu (edit, memo, combobox, ...) }
+{$IFDEF ContextMenuFix}
+type
+ TContextMenuFixWinControl = class(TWinControl)
+ public
+ procedure DefaultHandler(var Message); override;
+ end;
+
+var
+ RM_GetObjectInstance: DWORD;
+ BackupDefaultHandler: TXRedirCode;
+
+procedure TContextMenuFixWinControl.DefaultHandler(var Message);
+type
+ TDefHandler = procedure(Self: TControl; var Message);
+begin
+ if HandleAllocated then
+ begin
+ with TMessage(Message) do
+ begin
+ { Here was the WM_CONTEXTMENU Code that is not necessary because
+ DefWndProc will send this message to the parent control. }
+
+ { Keep the odd bahavior for grids because everybody seems to be used to it. }
+ if (Msg = WM_CONTEXTMENU) and (Parent <> nil) and (Parent is TCustomGrid) then
+ begin
+ Result := Parent.Perform(Msg, WParam, LParam);
+ if Result <> 0 then Exit;
+ end;
+
+ case Msg of
+ WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
+ Result := SendMessage(LParam, CN_BASE + Msg, WParam, LParam);
+ CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
+ begin
+ SetTextColor(WParam, ColorToRGB(Font.Color));
+ SetBkColor(WParam, ColorToRGB(Brush.Color));
+ Result := Brush.Handle;
+ end;
+ else
+ if Msg = RM_GetObjectInstance then
+ Result := LRESULT(Self)
+ else
+ Result := CallWindowProc(DefWndProc, Handle, Msg, WParam, LParam);
+ end;
+ if Msg = WM_SETTEXT then
+ SendDockNotification(Msg, WParam, LParam);
+ end;
+ end
+ else
+ //inherited DefaultHandler(Message);
+ TDefHandler(@TControl.DefaultHandler)(Self, Message);
+end;
+
+procedure InitContextMenuFix;
+var
+ HInst: HMODULE;
+begin
+ HInst := FindHInstance(Pointer(TWinControl)); // get the HInstance of the module that contains Controls.pas
+ RM_GetObjectInstance := RegisterWindowMessage(PChar(Format('ControlOfs%.8X%.8X', [HInst, GetCurrentThreadId])));
+
+ DebugLog('ContextMenuFix');
+ { Redirect the original function to the bug fixed version }
+ HookProc(@TWinControl.DefaultHandler, @TContextMenuFixWinControl.DefaultHandler, BackupDefaultHandler);
+end;
+
+procedure FiniContextMenuFix;
+begin
+ UnhookProc(@TWinControl.DefaultHandler, BackupDefaultHandler);
+end;
+{$ENDIF ContextMenuFix}
+{ ---------------------------------------------------------------------------- }
+
+
+
+{ ---------------------------------------------------------------------------- }
+{ QC #50097: ObjAuto access violation on XEON (Data Execution Prevention bug) }
+{$IFDEF ObjAutoDEPFix}
+
+type
+ PParameterInfos = ^TParameterInfos;
+ TParameterInfos = array[0..255] of ^PTypeInfo;
+
+ TMethodHandlerInstance = class
+ protected
+ MethodHandler: IMethodHandler;
+ TypeData: PTypeData;
+ ParamInfos: PParameterInfos;
+ Return: array[0..2] of Byte;
+ ParamOffsets: array of Word;
+ end;
+
+{ procedure TMethodHandlerInstance.RegisterStub;
+ 50 push eax
+ 51 push ecx
+ 52 push edx
+ 89E2 mov edx,esp
+ E866FDFFFF call TMethodHandlerInstance.Handler
+ 89442404 mov [esp+$04],eax
+ 58 pop eax
+ 58 pop eax
+ 59 pop ecx
+ 8D4910 lea ecx,[ecx+$10]
+ FFE1 jmp ecx
+ C3 ret }
+
+type
+ PRegisterStubRec = ^TRegisterStubRec;
+ TRegisterStubRec = packed record
+ Push3Reg: array[0..2] of Byte;
+ MovEdxEsp: Word;
+ CallHandler: array[0..4] of Byte;
+ SaveRetValue: LongWord;
+ Pop3Reg: array[0..2] of Byte;
+ case Integer of
+ 0: (LeaEcxEcx: Word;
+ Off: Byte;
+ JmpEcx: Word);
+ 1: (Jmp: Byte;
+ Offset: TJumpOfs);
+ end;
+
+var
+ RegisterStub: PRegisterStubRec;
+ OrgCode: array[0..4] of Byte;
+
+procedure RegisterStubRet;
+asm
+ lea ecx, [ecx].TMethodHandlerInstance.Return
+ cmp byte ptr [ecx], $C2
+ jne @@Leave
+ movzx ecx, word ptr [ecx+$01]
+ add ecx, 3
+ and ecx, $FC
+ add esp, ecx
+
+ { restore return address }
+ neg ecx
+ mov ecx, [esp+ecx] // load return address
+ push ecx // restore return address
+@@Leave:
+end;
+
+procedure InitObjAutoDEPFix;
+var
+ Func: TTypeData;
+ M: TMethod;
+ OldProtect: Cardinal;
+begin
+ FillChar(Func, SizeOf(Func), 0);
+ Func.MethodKind := mkProcedure;
+ Func.ParamCount := 0;
+ M := CreateMethodPointer(nil, @Func);
+ RegisterStub := M.Code;
+ ReleaseMethodPointer(M);
+
+ if (RegisterStub.Push3Reg[0] = $50) and
+ (RegisterStub.Push3Reg[1] = $51) and
+ (RegisterStub.Push3Reg[2] = $52) and
+ (RegisterStub.MovEdxEsp = $E289) and
+ (RegisterStub.SaveRetValue = $04244489) and
+ (RegisterStub.Pop3Reg[0] = $58) and
+ (RegisterStub.Pop3Reg[1] = $58) and
+ (RegisterStub.Pop3Reg[2] = $59) and
+ (RegisterStub.LeaEcxEcx = $498D) and
+ (RegisterStub.JmpEcx = $E1FF) then
+ begin
+ if VirtualProtect(@RegisterStub.Jmp, SizeOf(TXRedirCode), PAGE_EXECUTE_READWRITE, OldProtect) then
+ begin
+ DebugLog('ObjAutoDEPFix');
+ Move(RegisterStub.Jmp, OrgCode[0], SizeOf(OrgCode));
+ RegisterStub.Jmp := $E9;
+ RegisterStub.Offset := TJumpOfs(@RegisterStubRet) - (TJumpOfs(@RegisterStub.Jmp) + SizeOf(TXRedirCode));
+ VirtualProtect(@RegisterStub.Jmp, SizeOf(TXRedirCode), OldProtect, OldProtect);
+ FlushInstructionCache(GetCurrentProcess, @RegisterStub.Jmp, SizeOf(TXRedirCode));
+ end;
+ end
+ else
+ RegisterStub := nil;
+end;
+
+procedure FiniObjAutoDEPFix;
+var
+ OldProtect: Cardinal;
+begin
+ if RegisterStub <> nil then
+ begin
+ if VirtualProtect(@RegisterStub.Jmp, SizeOf(TXRedirCode), PAGE_EXECUTE_READWRITE, OldProtect) then
+ begin
+ Move(OrgCode[0], RegisterStub.Jmp, SizeOf(OrgCode));
+ VirtualProtect(@RegisterStub.Jmp, SizeOf(TXRedirCode), OldProtect, OldProtect);
+ FlushInstructionCache(GetCurrentProcess, @RegisterStub.Jmp, SizeOf(TXRedirCode));
+ end;
+ end;
+end;
+{$ENDIF ObjAutoDEPFix}
+{ ---------------------------------------------------------------------------- }
+
+
+
+{ ---------------------------------------------------------------------------- }
+{ Classes.MakeObjectInstance memory leak fix }
+{$IFDEF MkObjInstLeakFix}
+{ Limitation:
+ The memory is only released if there is no dangling object instance in the
+ memory block. }
+var
+ UnRegisterModuleClassesHook: TXRedirCode;
+ MkObjInstLeakHooked: Boolean;
+
+procedure HookedUnRegisterModuleClasses(Module: HMODULE);
+ forward;
+
+
+const
+ InstanceCount = 313;
+ PageSize = 4096;
+
+{ Object instance management }
+
+type
+ PPObjectInstance = ^PObjectInstance;
+ PObjectInstance = ^TObjectInstance;
+ TObjectInstance = packed record
+ Code: Byte;
+ Offset: Integer;
+ case Integer of
+ 0: (Next: PObjectInstance);
+ 1: (Method: TWndMethod);
+ end;
+
+ PPInstanceBlock = ^PInstanceBlock;
+ PInstanceBlock = ^TInstanceBlock;
+ TInstanceBlock = packed record
+ Next: PInstanceBlock;
+ Code: array[1..2] of Byte;
+ WndProcPtr: Pointer;
+ Instances: array[0..InstanceCount] of TObjectInstance;
+ end;
+
+(*
+ procedure FreeObjectInstance(ObjectInstance: Pointer);
+ begin
+ if ObjectInstance <> nil then
+ begin
+ // 85C0 test eax,eax
+ // 740E jz $0041b2f6
+ PObjectInstance(ObjectInstance)^.Next := InstFreeList;
+ // 8B15E8594600 mov edx,[$004659e8]
+ // 895005 mov [eax+$05],edx
+ InstFreeList := ObjectInstance;
+ // A3E8594600 mov [$004659e8],eax
+ end;
+ end;
+ // C3 ret
+*)
+
+type
+ TParamRec = packed record
+ Op: Word;
+ Off: Byte;
+ end;
+
+ PFreeObjInstRec = ^TFreeObjInstRec;
+ TFreeObjInstRec = packed record
+ TestEaxEax: Word;
+ Jz1: Word;
+ AssignToNext: packed record
+ MovEdx: Word;
+ Address: Cardinal;
+ MovEaxOffEdx: Word;
+ Off: Byte;
+ end;
+ AssignToInstFreeList: packed record
+ MovMemToEax: Byte;
+ Address: Cardinal;
+ end;
+ Ret: Byte;
+ end;
+
+ PFreeObjInstNoOptRec = ^TFreeObjInstNoOptRec;
+ TFreeObjInstNoOptRec = packed record
+ PushEbp: Byte; // $55
+ MovEbpEsp: Word; // $8B EC
+ PushEcx: Byte; // $51
+ MovOffReg: TParamRec; // $89 45 FC
+ Cmp: packed record
+ Op: Word; // $83 7D
+ Off: Byte; // $FC
+ Value: Byte; // $00
+ end;
+ Jz1: Word; // $74 14
+ LoadParam1: TParamRec; // $8B 45 FC
+ AssignToNext: packed record
+ MovEdx: Word; // $8B 15
+ Address: Cardinal;
+ end;
+ end;
+
+procedure GetObjectInstancePointers(out InstFreeListP: PPObjectInstance; out InstBlockListP: PPInstanceBlock);
+var
+ FreeObjInst: PFreeObjInstRec;
+ FreeObjInstNoOpt: PFreeObjInstNoOptRec;
+begin
+ InstFreeListP := nil;
+ InstBlockListP := nil;
+ FreeObjInst := GetActualAddr(@Classes.FreeObjectInstance);
+ FreeObjInstNoOpt := Pointer(FreeObjInst);
+
+ if (FreeObjInst.TestEaxEax = $C085) and (FreeObjInst.Jz1 = $0E74) and
+ (FreeObjInst.AssignToNext.MovEdx = $158B) and
+ (FreeObjInst.AssignToNext.MovEaxOffEdx = $5089) and (FreeObjInst.AssignToNext.Off = $05) and
+ (FreeObjInst.AssignToInstFreeList.MovMemToEax = $A3) and
+ (FreeObjInst.Ret = $C3) then
+ begin
+ InstFreeListP := PPObjectInstance(FreeObjInst.AssignToNext.Address);
+ InstBlockListP := PPInstanceBlock(FreeObjInst.AssignToNext.Address - SizeOf(Pointer));
+ end
+ else
+ if (FreeObjInstNoOpt.PushEbp = $55) and (FreeObjInstNoOpt.MovEbpEsp = $EC8B) and
+ (FreeObjInstNoOpt.PushEcx = $51) and
+ (FreeObjInstNoOpt.MovOffReg.Op = $4589) and (FreeObjInstNoOpt.MovOffReg.Off = $FC) and
+ (FreeObjInstNoOpt.Cmp.Op = $7D83) and (FreeObjInstNoOpt.Cmp.Off = $FC) and (FreeObjInstNoOpt.Cmp.Value = $00) and
+ (FreeObjInstNoOpt.Jz1 = $1474) and
+ (FreeObjInstNoOpt.LoadParam1.Op = $458B) and (FreeObjInstNoOpt.LoadParam1.Off = $FC) and
+ (FreeObjInstNoOpt.AssignToNext.MovEdx = $158B) then
+ begin
+ InstFreeListP := PPObjectInstance(FreeObjInstNoOpt.AssignToNext.Address);
+ InstBlockListP := PPInstanceBlock(FreeObjInstNoOpt.AssignToNext.Address - SizeOf(Pointer));
+ end;
+end;
+
+procedure CleanupInstFreeList(var InstFreeList: PObjectInstance; BlockStart, BlockEnd: PAnsiChar);
+var
+ Prev, Next, Item: PObjectInstance;
+begin
+ Prev := nil;
+ Item := InstFreeList;
+ while Item <> nil do
+ begin
+ Next := Item.Next;
+ if (PAnsiChar(Item) >= BlockStart) and (PAnsiChar(Item) <= BlockEnd) then
+ begin
+ Item := Prev;
+ if Prev = nil then
+ InstFreeList := Next
+ else
+ Prev.Next := Next;
+ end;
+ Prev := Item;
+ Item := Next;
+ end;
+end;
+
+function CalcFreeInstBlockItems(Item: PObjectInstance; Block: PInstanceBlock): Integer;
+var
+ I: Integer;
+begin
+ Result := 0;
+ while Item <> nil do
+ begin
+ for I := High(Block.Instances) downto 0 do
+ begin
+ if @Block.Instances[I] = Item then
+ begin
+ Inc(Result);
+ Break;
+ end;
+ end;
+ Item := Item.Next;
+ end;
+end;
+
+procedure ReleaseObjectInstanceBlocks;
+var
+ InstFreeListP: PPObjectInstance;
+ InstBlockListP: PPInstanceBlock;
+ NextBlock, Block, PrevBlock: PInstanceBlock;
+ FreeCount: Integer;
+begin
+ GetObjectInstancePointers(InstFreeListP, InstBlockListP);
+ if (InstFreeListP = nil) or (InstBlockListP = nil) then
+ begin
+ OutputDebugString('Cannot apply Classes.FreeObjectInstance memory leak-fix');
+ Exit;
+ end;
+
+ Block := InstBlockListP^;
+ PrevBlock := nil;
+ while Block <> nil do
+ begin
+ NextBlock := Block.Next;
+
+ { Obtain the number of free items in the InstanceBlock }
+ FreeCount := CalcFreeInstBlockItems(InstFreeListP^, Block);
+
+ { Release memory if the InstanceBlock contains only "free" items }
+ if FreeCount = Length(Block.Instances) then
+ begin
+ { Remove all InstFreeList items that refer to the InstanceBlock }
+ CleanupInstFreeList(InstFreeListP^, PAnsiChar(Block), PAnsiChar(Block) + SizeOf(TInstanceBlock) - 1);
+
+ VirtualFree(Block, 0, MEM_RELEASE);
+
+ Block := PrevBlock;
+ if PrevBlock = nil then
+ InstBlockListP^ := NextBlock
+ else
+ PrevBlock.Next := NextBlock;
+ end;
+
+ { Next InstanceBlock }
+ PrevBlock := Block;
+ Block := NextBlock;
+ end;
+
+ { Maybe the finalization was executed before the Application object was destroyed.
+ Classes.Finalization calls UnRegisterModuleClasses(). We hook into that function
+ to execute our finalization in the Classes.Finalization. }
+ if (InstBlockListP^ <> nil) and not MkObjInstLeakHooked and
+ (FindHInstance(GetActualAddr(@UnRegisterModuleClasses)) = HInstance) then
+ begin
+ MkObjInstLeakHooked := True;
+ HookProc(@UnRegisterModuleClasses, @HookedUnRegisterModuleClasses, UnRegisterModuleClassesHook);
+ end;
+end;
+
+procedure HookedUnRegisterModuleClasses(Module: HMODULE);
+begin
+ UnhookProc(@UnRegisterModuleClasses, UnRegisterModuleClassesHook);
+ try
+ UnRegisterModuleClasses(Module);
+ if Module = HInstance then
+ ReleaseObjectInstanceBlocks;
+ finally
+ HookProc(@UnRegisterModuleClasses, @HookedUnRegisterModuleClasses, UnRegisterModuleClassesHook);
+ end;
+end;
+{$ENDIF MkObjInstLeakFix}
+{ ---------------------------------------------------------------------------- }
+
+
+
+{ ---------------------------------------------------------------------------- }
+{ QC #58938: MainForm Minimize minimizes in the background }
+{$IFDEF AppMinimizeFix}
+var
+ AppMinimizePatchAddress: ^TJumpOfs;
+ OrgAppMinimizeSetActiveWindowOffset: TJumpOfs;
+
+function ApplicationMinimizeSetActiveWindow(hWnd: HWND): HWND; stdcall;
+begin
+ if Application.MainFormOnTaskBar then
+ Result := GetActiveWindow
+ else
+ Result := SetActiveWindow(hWnd);
+end;
+
+{
+Forms.pas.7850: NormalizeTopMosts;
+8BC3 mov eax,ebx
+E84AF4FFFF call TApplication.NormalizeTopMosts
+Forms.pas.7851: SetActiveWindow(FHandle); // WM_ACTIVATEAPP can set AppIconic to False
+8B4330 mov eax,[ebx+$30]
+50 push eax
+E87D1AFAFF call SetActiveWindow
+Forms.pas.7852: AppIconic := True; // Set AppIconic here just to be safe
+C605A8EC4B0001 mov byte ptr [$004beca8],$01
+}
+
+procedure InitAppMinimizeFix;
+var
+ P: PAnsiChar;
+ Len: Integer;
+ NewOffset: TJumpOfs;
+ n: Cardinal;
+begin
+ P := GetActualAddr(@TApplication.Minimize);
+ Len := 0;
+ while Len < 64 do
+ begin
+ if (P[0] = #$8B) and (P[1] = #$C3) and // mov eax,ebx
+ (P[2] = #$E8) and // call TApplication.NormalizeTopMosts
+ (P[7] = #$8B) and (P[8] = #$43) and (P[9] = #$30) and // mov eax,[ebx+$30]
+ (P[10] = #$50) and // push eax
+ (P[11] = #$E8) and // call SetActiveWindow
+ (P[16] = #$C6) and (P[17] = #$05) and (P[22] = #$01) then // mov byte ptr [$004beca8],$01
+ begin
+ DebugLog('AppMinimizeFix');
+ AppMinimizePatchAddress := Pointer(P + 12);
+ OrgAppMinimizeSetActiveWindowOffset := AppMinimizePatchAddress^;
+ NewOffset := PAnsiChar(@ApplicationMinimizeSetActiveWindow) - PAnsiChar(AppMinimizePatchAddress) - SizeOf(TJumpOfs);
+ WriteProcessMemory(GetCurrentProcess, AppMinimizePatchAddress, @NewOffset, SizeOf(NewOffset), n);
+ Exit;
+ end;
+ Inc(P);
+ Inc(Len);
+ end;
+end;
+
+procedure FiniAppMinimizeFix;
+var
+ n: Cardinal;
+begin
+ if AppMinimizePatchAddress <> nil then
+ WriteProcessMemory(GetCurrentProcess, AppMinimizePatchAddress, @OrgAppMinimizeSetActiveWindowOffset, SizeOf(TJumpOfs), n);
+end;
+{$ENDIF AppMinimizeFix}
+{ ---------------------------------------------------------------------------- }
+
+
+
+{ ---------------------------------------------------------------------------- }
+{ QC #64484: SysUtils.Abort can raise an AccessViolation }
+{$IFDEF SysUtilsAbortFix}
+var
+ SysUtilsAbortHook: TXRedirCode;
+
+procedure SysUtilsAbort;
+{ No dependency on EBP register }
+
+ procedure ThrowException(ReturnAddr: Pointer);
+ begin
+ raise EAbort.CreateRes(@SOperationAborted) at ReturnAddr;
+ end;
+
+asm
+ pop eax
+ jmp ThrowException
+end;
+
+procedure InitSysUtilsAbortFix;
+begin
+ DebugLog('SysUtilsAbortFix');
+ HookProc(@SysUtils.Abort, @SysUtilsAbort, SysUtilsAbortHook);
+end;
+
+procedure FiniSysUtilsAbortFix;
+begin
+ UnhookProc(@SysUtils.Abort, SysUtilsAbortHook);
+end;
+{$ENDIF SysUtilsAbortFix}
+{ ---------------------------------------------------------------------------- }
+
+
+
+{ ---------------------------------------------------------------------------- }
+{ QC #58939: No taskbar button when starting from shelllink with Show=Minimized }
+{$IFDEF CmdShowMinimizeFix}
+var
+ ApplicationRunHook: TXRedirCode;
+ InitialMainFormState: ^TWindowState;
+
+procedure ApplicationRun(App: TApplication);
+begin
+ UnhookProc(@TApplication.Run, ApplicationRunHook);
+ ApplicationRunHook.Jump := 0;
+ {$WARNINGS OFF}
+ if (CmdShow = SW_SHOWMINNOACTIVE) and (InitialMainFormState <> nil) then
+ {$WARNINGS ON}
+ InitialMainFormState^ := wsMinimized;
+ App.Run;
+end;
+
+{
+Forms.pas.8214: if (FMainForm.FWindowState = wsMinimized) or (InitialMainFormState = wsMinimized) then
+8B45FC mov eax,[ebp-$04]
+8B4044 mov eax,[eax+$44]
+80B87302000001 cmp byte ptr [eax+$00000273],$01
+7409 jz $004669a5
+803DC8784B0001 cmp byte ptr [$004b78c8],$01
+751E jnz $004669c3
+Forms.pas.8216: Minimize;
+8B45FC mov eax,[ebp-$04]
+E8FFF5FFFF call TApplication.Minimize
+Forms.pas.8217: if (InitialMainFormState = wsMinimized) then
+803DC8784B0001 cmp byte ptr [$004b78c8],$01
+7514 jnz $004669ca
+}
+
+function FindInitialMainFormState: Pointer;
+var
+ P: PAnsiChar;
+ Len: Integer;
+begin
+ P := GetActualAddr(@TApplication.Run);
+ Len := 0;
+ while Len < 128 do
+ begin
+ if (P[0] = #$74) and (P[1] = #$09) and // jz $004669a5
+ (P[2] = #$80) and (P[3] = #$3D) and (P[8] = #$01) and // cmp byte ptr [$004b78c8],$01
+ (P[9] = #$75) and (P[10] = #$1E) and // jnz $004669c3
+ (P[11] = #$8B) and (P[12] = #$45) and (P[13] = #$FC) then // mov eax,[ebp-$04]
+ begin
+ DebugLog('CmdShowMinimizeFix');
+ Result := PPointer(P + 4)^;
+ Exit;
+ end;
+ Inc(P);
+ Inc(Len);
+ end;
+ Result := nil;
+end;
+
+procedure InitCmdShowMinimizeFix;
+begin
+ InitialMainFormState := FindInitialMainFormState;
+ if InitialMainFormState <> nil then
+ HookProc(@TApplication.Run, @ApplicationRun, ApplicationRunHook);
+end;
+
+procedure FiniCmdShowMinimizeFix;
+begin
+ UnhookProc(@TApplication.Run, ApplicationRunHook);
+end;
+
+{$ENDIF CmdShowMinimizeFix}
+{ ---------------------------------------------------------------------------- }
+
+
+
+{ ---------------------------------------------------------------------------- }
+{ QC #35001: MDIChild's active control focus is not set correctly }
+{$IFDEF MDIChildFocusFix}
+var
+ CustomFormFocusControlHook: TXRedirCode;
+
+procedure CustomFormFocusControl(Self: TOpenCustomForm; Control: TWinControl);
+var
+ WasActive: Boolean;
+begin
+ with Self do
+ begin
+ WasActive := Active;
+
+ { Synchronize Windows's focus with VCL's focus }
+ if WasActive and (FormStyle = fsMDIChild) and (Control <> nil) and (Control = ActiveControl) and
+ Control.HandleAllocated and not Control.Focused then
+ begin
+ Windows.SetFocus(Control.Handle);
+ end;
+
+ ActiveControl := Control;
+ if not WasActive then
+ SetFocus;
+ end;
+end;
+
+procedure InitMDIChildFocusFix;
+begin
+ DebugLog('MDIChildFocusFix');
+ HookProc(@TOpenCustomForm.FocusControl, @CustomFormFocusControl, CustomFormFocusControlHook);
+end;
+
+procedure FiniMDIChildFocusFix;
+begin
+ UnhookProc(@TOpenCustomForm.FocusControl, CustomFormFocusControlHook);
+end;
+{$ENDIF MDIChildFocusFix}
+{ ---------------------------------------------------------------------------- }
+
+
+
+{ ---------------------------------------------------------------------------- }
+{ QC #56252: TPageControl flickers a lot with active theming }
+{ QC #68730: TLabel is not painted on a themed, double-buffered TTabSheet in Vista }
+{ TLabels on TTabSheet are not painted (themes) if a TWinControl like TMemo is on the TTabSheet (TWinControl.PaintWindow bug) }
+{$IFDEF PageControlPaintingFix}
+type
+ TFlickerlessPageControl = class(TPageControl)
+ procedure NewWndProc(var Msg: TMessage);
+ end;
+
+ TFlickerlessTabSheet = class(TTabSheet)
+ protected
+ procedure NewCreateParams(var Params: TCreateParams);
+ procedure WMPrintClient(var Message: TWMPrintClient); message WM_PRINTCLIENT;
+ procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
+
+ procedure NewWndProc(var Msg: TMessage);
+ end;
+
+{ TFlickerlessPageControl }
+
+procedure TFlickerlessPageControl.NewWndProc(var Msg: TMessage);
+begin
+ case Msg.Msg of
+ WM_SIZE:
+ begin
+ inherited WndProc(Msg);
+ { Update the page control immediately to prevent flicker }
+ if ThemeServices.ThemesEnabled then
+ RedrawWindow(Handle, nil, 0, RDW_UPDATENOW or RDW_ERASE);
+ end;
+ else
+ inherited WndProc(Msg); // "inherited" is required here, otherwise this would be an endless recursion
+ end;
+end;
+
+{ TFlickerlessTabSheet }
+
+procedure TFlickerlessTabSheet.WMEraseBkgnd(var Message: TWMEraseBkgnd);
+var
+ R: TRect;
+begin
+ if (PageControl <> nil) and (PageControl.Style = tsTabs) and ThemeServices.ThemesEnabled then
+ begin
+ { Paint the TabSheet background without filling the gray color from the parent.
+ And fill it in WM_ERASEBKGND where it belongs instead of WM_PRINTCLIENT. }
+ GetWindowRect(Handle, R);
+ OffsetRect(R, -R.Left, -R.Top);
+ ThemeServices.DrawElement(Message.DC, ThemeServices.GetElementDetails(ttBody), R);
+ Message.Result := 1;
+ end
+ else
+ inherited;
+end;
+
+procedure TFlickerlessTabSheet.WMPrintClient(var Message: TWMPrintClient);
+begin
+ { Fixes "Labels are not painted if themes are enabled" bug }
+
+ { Description see QC #3850 / RAID #159864, same as in TFrame.
+
+ A better solution would be to change TWinControl.PaintWindow to
+ use WM_PRINTCLIENT if it is called from a WM_PRINTCLIENT handler
+ and to use WM_PAINT only if it is called from a WM_PAINT handler. }
+
+ DefaultHandler(Message);
+ PaintControls(Message.DC, nil);
+end;
+
+procedure TFlickerlessTabSheet.NewCreateParams(var Params: TCreateParams);
+begin
+ inherited CreateParams(Params);
+ if ThemeServices.ThemesEnabled then
+ Params.WindowClass.style := Params.WindowClass.style and not (CS_VREDRAW or CS_HREDRAW);
+end;
+
+procedure TFlickerlessTabSheet.NewWndProc(var Msg: TMessage);
+begin
+ { Instead of hooking the DMT we simply call the replacement handlers directly }
+ case Msg.Msg of
+ WM_ERASEBKGND:
+ WMEraseBkgnd(TWMEraseBkgnd(Msg));
+ WM_PRINTCLIENT:
+ WMPrintClient(TWMPrintClient(Msg));
+ WM_SIZE:
+ begin
+ inherited WndProc(Msg);
+ if ThemeServices.ThemesEnabled then
+ RedrawWindow(Handle, nil, 0, RDW_UPDATENOW or RDW_INVALIDATE or RDW_ERASE or RDW_ALLCHILDREN);
+ end;
+ else
+ inherited WndProc(Msg); // "inherited" is required here, otherwise this would be an endless recursion
+ end;
+end;
+
+procedure InitPageControlPaintingFix;
+begin
+ DebugLog('PageControlPaintingFix');
+ ReplaceVmtField(TTabSheet, @TFlickerlessTabSheet.WndProc, @TFlickerlessTabSheet.NewWndProc);
+ ReplaceVmtField(TTabSheet, @TFlickerlessTabSheet.CreateParams, @TFlickerlessTabSheet.NewCreateParams);
+ ReplaceVmtField(TPageControl, @TFlickerlessPageControl.WndProc, @TFlickerlessPageControl.NewWndProc);
+end;
+
+procedure FiniPageControlPaintingFix;
+begin
+ ReplaceVmtField(TTabSheet, @TFlickerlessTabSheet.NewWndProc, @TFlickerlessTabSheet.WndProc);
+ ReplaceVmtField(TTabSheet, @TFlickerlessTabSheet.NewCreateParams, @TFlickerlessTabSheet.CreateParams);
+ ReplaceVmtField(TPageControl, @TFlickerlessPageControl.NewWndProc, @TFlickerlessPageControl.WndProc);
+end;
+{$ENDIF PageControlPaintingFix}
+{---------------------------------------------------------------------------}
+
+
+
+{---------------------------------------------------------------------------}
+{$IFDEF GridFlickerFix}
+type
+ {$IFDEF VCLFIXPACK_DB_SUPPORT}
+ TFlickerlessDBGrid = class(TDBGrid)
+ protected
+ procedure NewWndProc(var Msg: TMessage);
+ end;
+ {$ENDIF VCLFIXPACK_DB_SUPPORT}
+
+ TFlickerlessStringGrid = class(TStringGrid)
+ protected
+ procedure NewWndProc(var Msg: TMessage);
+ end;
+
+ TFlickerlessDrawGrid = class(TDrawGrid)
+ protected
+ procedure NewWndProc(var Msg: TMessage);
+ end;
+
+{ TFlickerlessDBGrid }
+
+procedure GridWMEraseBkgnd(Grid: TCustomGrid; var Message: TWMEraseBkgnd);
+var
+ R: TRect;
+ Size: TSize;
+begin
+ { Fill the area between the two scroll bars. }
+ Size.cx := GetSystemMetrics(SM_CXVSCROLL);
+ Size.cy := GetSystemMetrics(SM_CYHSCROLL);
+ if {Grid.BiDiMode <> bdLeftToRight}Grid.UseRightToLeftAlignment then
+ R := Bounds(0, Grid.Height - Size.cy, Size.cx, Size.cy)
+ else
+ R := Bounds(Grid.Width - Size.cx, Grid.Height - Size.cy, Size.cx, Size.cy);
+ FillRect(Message.DC, R, Grid.Brush.Handle);
+ Message.Result := 1;
+end;
+
+{$IFDEF VCLFIXPACK_DB_SUPPORT}
+procedure TFlickerlessDBGrid.NewWndProc(var Msg: TMessage);
+{var
+ Rect: TRect;}
+begin
+ if Msg.Msg = WM_ERASEBKGND then
+ GridWMEraseBkgnd(Self, TWMEraseBkgnd(Msg))
+ else if Msg.Msg = WM_PAINT then
+ begin
+ {if UseRightToLeftAlignment then
+ Begin
+ Rect.TopLeft := ClientRect.TopLeft;
+ Rect.BottomRight := ClientRect.BottomRight;
+ InvalidateRect(Handle, @Rect, False);
+ end;}
+ inherited WndProc(Msg);
+ end
+ else
+ inherited WndProc(Msg);
+end;
+{$ENDIF VCLFIXPACK_DB_SUPPORT}
+
+procedure TFlickerlessStringGrid.NewWndProc(var Msg: TMessage);
+begin
+ if Msg.Msg = WM_ERASEBKGND then
+ GridWMEraseBkgnd(Self, TWMEraseBkgnd(Msg))
+ else
+ inherited WndProc(Msg);
+end;
+
+procedure TFlickerlessDrawGrid.NewWndProc(var Msg: TMessage);
+begin
+ if Msg.Msg = WM_ERASEBKGND then
+ GridWMEraseBkgnd(Self, TWMEraseBkgnd(Msg))
+ else
+ inherited WndProc(Msg);
+end;
+
+procedure InitGridFlickerFix;
+begin
+ DebugLog('GridFlickerFix');
+ {$IFDEF VCLFIXPACK_DB_SUPPORT}
+ ReplaceVmtField(TDBGrid, @TFlickerlessDBGrid.WndProc, @TFlickerlessDBGrid.NewWndProc);
+ {$ENDIF VCLFIXPACK_DB_SUPPORT}
+ ReplaceVmtField(TStringGrid, @TFlickerlessStringGrid.WndProc, @TFlickerlessStringGrid.NewWndProc);
+ ReplaceVmtField(TDrawGrid, @TFlickerlessDrawGrid.WndProc, @TFlickerlessDrawGrid.NewWndProc);
+end;
+
+procedure FiniGridFlickerFix;
+begin
+ {$IFDEF VCLFIXPACK_DB_SUPPORT}
+ ReplaceVmtField(TDBGrid, @TFlickerlessDBGrid.NewWndProc, @TFlickerlessDBGrid.WndProc);
+ {$ENDIF VCLFIXPACK_DB_SUPPORT}
+ ReplaceVmtField(TStringGrid, @TFlickerlessStringGrid.NewWndProc, @TFlickerlessStringGrid.WndProc);
+ ReplaceVmtField(TDrawGrid, @TFlickerlessDrawGrid.NewWndProc, @TFlickerlessDrawGrid.WndProc);
+end;
+{$ENDIF GridFlickerFix}
+{---------------------------------------------------------------------------}
+
+
+
+{ ---------------------------------------------------------------------------- }
+{ QC #69112: TSpeedButton is painted as a black rectangle on a double buffered panel on a sheet of glass. }
+{$IFDEF SpeedButtonGlassFix}
+type
+ TGlassableSpeedButton = class(TSpeedButton)
+ procedure NewWndProc(var Msg: TMessage);
+ end;
+
+function ControlInGlassPaint(AControl: TControl): Boolean;
+var
+ Parent: TWinControl;
+begin
+ Result := csGlassPaint in AControl.ControlState;
+ if Result then
+ begin
+ { Control could be on a double buffered control. In that case the csGlassPaint flag
+ shouldn't be set. }
+ Parent := AControl.Parent;
+ while (Parent <> nil) and not Parent.DoubleBuffered and not (Parent is TCustomForm) do
+ Parent := Parent.Parent;
+ Result := (Parent = nil) or not Parent.DoubleBuffered or (Parent is TCustomForm);
+ end;
+end;
+
+{ TGlassableSpeedButton }
+
+procedure TGlassableSpeedButton.NewWndProc(var Msg: TMessage);
+begin
+ if (Msg.Msg = WM_PAINT) and (csGlassPaint in ControlState) and
+ not ControlInGlassPaint(Self) then
+ begin
+ ControlState := ControlState - [csGlassPaint];
+ try
+ inherited WndProc(Msg);
+ finally
+ ControlState := ControlState + [csGlassPaint];
+ end;
+ end
+ else
+ inherited WndProc(Msg);
+end;
+
+procedure InitSpeedButtonGlassFix;
+begin
+ DebugLog('SpeedButtonGlassFix');
+ ReplaceVmtField(TSpeedButton, @TGlassableSpeedButton.WndProc, @TGlassableSpeedButton.NewWndProc);
+ {$IFDEF VCLFIXPACK_DB_SUPPORT}
+ ReplaceVmtField(TNavButton, @TGlassableSpeedButton.WndProc, @TGlassableSpeedButton.NewWndProc);
+ {$ENDIF VCLFIXPACK_DB_SUPPORT}
+end;
+
+procedure FiniSpeedButtonGlassFix;
+begin
+ ReplaceVmtField(TSpeedButton, @TGlassableSpeedButton.NewWndProc, @TGlassableSpeedButton.WndProc);
+ {$IFDEF VCLFIXPACK_DB_SUPPORT}
+ ReplaceVmtField(TNavButton, @TGlassableSpeedButton.NewWndProc, @TGlassableSpeedButton.WndProc);
+ {$ENDIF VCLFIXPACK_DB_SUPPORT}
+end;
+{$ENDIF SpeedButtonGlassFix}
+{ ---------------------------------------------------------------------------- }
+
+
+
+{ ---------------------------------------------------------------------------- }
+{ QC #69294: TProgressBar fails with PBS_MARQUEE and disabled Themes }
+{$IFDEF VistaProgressBarMarqueeFix}
+type
+ TVistaProgressBarMarqueeFix = class(TProgressBar)
+ protected
+ procedure SetMarqueeInterval(Value: Integer);
+ procedure CreateParamsFix(var Params: TCreateParams);
+ procedure CreateWndFix;
+ end;
+
+var
+ SetMarqueeIntervalHook: TXRedirCode;
+ SetMarqueeInterval: Pointer;
+
+procedure TVistaProgressBarMarqueeFix.SetMarqueeInterval(Value: Integer);
+var
+ MarqueeEnabled: Boolean;
+begin
+ PInteger(@MarqueeInterval)^ := Value;
+ if (Style = pbstMarquee) and HandleAllocated then
+ begin
+ MarqueeEnabled := Style = pbstMarquee;
+ SendMessage(Handle, PBM_SETMARQUEE, WPARAM(MarqueeEnabled), LPARAM(MarqueeInterval));
+ end;
+end;
+
+procedure TVistaProgressBarMarqueeFix.CreateParamsFix(var Params: TCreateParams);
+begin
+ inherited CreateParams(Params);
+ if Style = pbstMarquee then
+ Params.Style := Params.Style or PBS_MARQUEE;
+end;
+
+procedure TVistaProgressBarMarqueeFix.CreateWndFix;
+var
+ MarqueeEnabled: Boolean;
+begin
+ inherited CreateWnd;
+ MarqueeEnabled := Style = pbstMarquee;
+ SendMessage(Handle, PBM_SETMARQUEE, WPARAM(THandle(MarqueeEnabled)), LPARAM(MarqueeInterval));
+end;
+
+procedure InitVistaProgressBarMarqueeFix;
+var
+ PropInfo: PPropInfo;
+begin
+ if CheckWin32Version(6, 0) then
+ begin
+ ReplaceVmtField(TProgressBar, @TVistaProgressBarMarqueeFix.CreateParams, @TVistaProgressBarMarqueeFix.CreateParamsFix);
+ ReplaceVmtField(TProgressBar, @TVistaProgressBarMarqueeFix.CreateWnd, @TVistaProgressBarMarqueeFix.CreateWndFix);
+ PropInfo := GetPropInfo(TProgressBar, 'MarqueeInterval');
+ if (PropInfo <> nil) and (PropInfo.SetProc <> nil) and
+ not (Byte(DWORD_PTR(PropInfo.SetProc) shr 24) in [$FF, $FE]) then
+ begin
+ SetMarqueeInterval := PropInfo.SetProc;
+ HookProc(SetMarqueeInterval, @TVistaProgressBarMarqueeFix.SetMarqueeInterval, SetMarqueeIntervalHook);
+ end;
+ DebugLog('VistaProgressBarMarqueeFix');
+ end;
+end;
+
+procedure FiniVistaProgressBarMarqueeFix;
+begin
+ if CheckWin32Version(6, 0) then
+ begin
+ ReplaceVmtField(TProgressBar, @TVistaProgressBarMarqueeFix.CreateParamsFix, @TVistaProgressBarMarqueeFix.CreateParams);
+ ReplaceVmtField(TProgressBar, @TVistaProgressBarMarqueeFix.CreateWndFix, @TVistaProgressBarMarqueeFix.CreateWnd);
+ UnhookProc(SetMarqueeInterval, SetMarqueeIntervalHook);
+ end;
+end;
+{$ENDIF VistaProgressBarMarqueeFix}
+{ ---------------------------------------------------------------------------- }
+
+
+{ ---------------------------------------------------------------------------- }
+{ QC #52439: DbNavigator paints incorrectly when flat=true in themed mode }
+{$IFDEF DBNavigatorFix}
+type
+ TOpenDBNavigator = class(TDBNavigator)
+ public
+ procedure SetFlatFixed(Value: Boolean);
+ end;
+
+var
+ DBNavigatorSetFlat: Pointer;
+ DBNavigatorSetFlatHook: TXRedirCode;
+
+procedure TOpenDBNavigator.SetFlatFixed(Value: Boolean);
+var
+ I: TNavigateBtn;
+begin
+ if Flat <> Value then
+ begin
+ Boolean(Pointer(@Flat)^) := Value; // FFlat := Value
+ for I := Low(Buttons) to High(Buttons) do
+ Buttons[I].Flat := Value;
+ if Flat then
+ ControlStyle := ControlStyle - [csOpaque]
+ else
+ ControlStyle := ControlStyle + [csOpaque];
+ end;
+end;
+
+procedure InitDBNavigatorFix;
+var
+ Info: PPropInfo;
+begin
+ Info := GetPropInfo(TDBNavigator, 'Flat');
+ if (Info <> nil) and (Info.SetProc <> nil) then
+ begin
+ DBNavigatorSetFlat := Info.SetProc;
+ HookProc(DBNavigatorSetFlat, @TOpenDBNavigator.SetFlatFixed, DBNavigatorSetFlatHook);
+ DebugLog('DBNavigatorFix');
+ end;
+end;
+
+procedure FiniDBNavigatorFix;
+begin
+ UnhookProc(DBNavigatorSetFlat, DBNavigatorSetFlatHook);
+end;
+{$ENDIF DBNavigatorFix}
+{ ---------------------------------------------------------------------------- }
+
+
+{ ---------------------------------------------------------------------------- }
+{ QC #70441: ToUpper and ToLower modify a Const argument
+ QC #69752: ToUpper and ToLower with NullString }
+{$IFDEF CharacterFix}
+var
+ TCharacter_ToLowerHook, TCharacter_ToUpperHook: TXRedirCode;
+
+function TCharacter_ToLower(const S: string): string;
+var
+ Len: Integer;
+begin
+ if S <> '' then
+ begin
+ Len := Length(S);
+ SetLength(Result, Len);
+ if LCMapString(GetThreadLocale, LCMAP_LOWERCASE, PChar(S), Len, PChar(Result), Len) = 0 then
+ RaiseLastOSError;
+ end
+ else
+ Result := S;
+end;
+
+function TCharacter_ToUpper(const S: string): string;
+var
+ Len: Integer;
+begin
+ if S <> '' then
+ begin
+ Len := Length(S);
+ SetLength(Result, Len);
+ if LCMapString(GetThreadLocale, LCMAP_UPPERCASE, PChar(S), Len, PChar(Result), Len) = 0 then
+ RaiseLastOSError;
+ end
+ else
+ Result := S;
+end;
+
+procedure InitCharacterFix;
+begin
+ DebugLog('CharacterFix');
+ HookProc(@TCharacter.ToLower, @TCharacter_ToLower, TCharacter_ToLowerHook);
+ HookProc(@TCharacter.ToUpper, @TCharacter_ToUpper, TCharacter_ToUpperHook);
+end;
+
+procedure FiniCharacterFix;
+begin
+ UnhookProc(@TCharacter.ToLower, TCharacter_ToLowerHook);
+ UnhookProc(@TCharacter.ToUpper, TCharacter_ToUpperHook);
+end;
+{$ENDIF CharacterFix}
+{ ---------------------------------------------------------------------------- }
+
+
+{ ---------------------------------------------------------------------------- }
+{ QC #69875: StringBuilder.Replace is incorrect
+ + a much faster implementation }
+{$IFDEF StringBuilderFix}
+var
+ TStringBuilder_ReplaceHook: TXRedirCode;
+
+type
+ TStringBuilderFix = class(TStringBuilder)
+ public
+ function Replace(const OldValue, NewValue: string; StartIndex, Count: Integer): TStringBuilder;
+ end;
+
+function TStringBuilderFix.Replace(const OldValue, NewValue: string;
+ StartIndex, Count: Integer): TStringBuilder;
+
+ procedure OffsetChars(Data: PChar; Offset: Integer; EndP: PChar); inline;
+ begin
+ Move(Data^, PChar(Data + Offset)^, (EndP - Data) * SizeOf(Char));
+ end;
+
+var
+ P, EndP, F: PChar;
+ FirstChar: Char;
+ OldValueLen, NewValueLen, DataLen: Integer;
+ FoundCount, I: Integer;
+ StackStart: Pointer;
+ StackP: ^PChar;
+ SizeChange: Integer;
+ NewLength: Integer;
+begin
+ { Bounds checking }
+ DataLen := System.Length(FData);
+ if StartIndex + Count >= DataLen then
+ Count := DataLen - StartIndex;
+
+ if (Count <= 0) or (StartIndex < 0) or (StartIndex >= DataLen) or (OldValue = '') then
+ Exit(Self);
+
+ OldValueLen := System.Length(OldValue);
+ NewValueLen := System.Length(NewValue);
+ SizeChange := NewValueLen - OldValueLen;
+
+ { Start stack position-buffer }
+ asm mov StackStart, esp end;
+
+ FoundCount := 0;
+ FirstChar := PChar(Pointer(OldValue))^;
+
+ P := PChar(@FData[StartIndex]);
+ while Count > 0 do
+ begin
+ while (Count > 0) and (P^ <> FirstChar) do
+ begin
+ Inc(P);
+ Dec(Count);
+ end;
+
+ if Count > 0 then
+ begin
+ if (OldValueLen = 1) or (StrLComp(P + 1, PChar(Pointer(OldValue)) + 1, OldValueLen - 1) = 0) then
+ begin
+ if SizeChange = 0 then
+ begin
+ { Replace inplace }
+ Move(NewValue[1], P^, OldValueLen * SizeOf(Char));
+ end
+ else
+ begin
+ { Save position to the stack and proceed }
+ asm push P end;
+ Inc(FoundCount);
+ end;
+ Inc(P, OldValueLen - 1);
+ Dec(Count, OldValueLen - 1);
+ end;
+ end;
+ Inc(P);
+ Dec(Count);
+ end;
+
+ NewLength := FLength + SizeChange * FoundCount;
+ if FoundCount > 0 then { Expand }
+ begin
+ { Offset the data from right to left }
+ if SizeChange > 0 then
+ begin
+ { Resize FData to the new length }
+ F := @FData[0];
+ if NewLength > System.Length(FData) then
+ SetLength(FData, NewLength);
+ EndP := PChar(@FData[FLength - 1]) + 1;
+
+ while FoundCount > 0 do
+ begin
+ asm pop P end; { take the last position from the stack }
+ P := PChar(@FData[0]) + (P - F);
+ { Offset all chars right to the OldValue by FoundCount*SizeChange }
+ OffsetChars(P + OldValueLen, FoundCount * SizeChange, EndP);
+ EndP := P;
+ { Put the NewValue into the buffer }
+ Move(NewValue[1], PChar(P + (FoundCount - 1) * SizeChange)^, NewValueLen * SizeOf(Char));
+ Dec(FoundCount);
+ end;
+ end
+ else { SizeChange < 0, Shrink }
+ begin
+ { Offset the data from left to right }
+
+ { Push the terminator to the stack; the loop uses the "next position" as EndP }
+ EndP := PChar(@FData[FLength - 1]) + 1;
+ asm push EndP end;
+
+ StackP := Pointer(INT_PTR(StackStart) - SizeOf(Pointer));
+ I := 0;
+ while FoundCount > 0 do
+ begin
+ P := StackP^;
+ Dec(StackP);
+ EndP := StackP^;
+ { Offset all chars right to the OldValue by FoundCount*SizeChange }
+ OffsetChars(@P[OldValueLen], (I + 1) * SizeChange, EndP);
+ { Put the NewValue into the buffer }
+ if NewValue <> '' then
+ Move(NewValue[1], P[I * SizeChange], NewValueLen * SizeOf(Char));
+ Inc(I);
+ Dec(FoundCount);
+ end;
+
+ {if NewLength > System.Length(FData) then
+ SetLength(FData, NewLength);}
+ end;
+ end;
+
+ { Release stack memory }
+ asm mov esp, StackStart end;
+
+ FLength := NewLength;
+ Result := Self;
+end;
+
+procedure InitStringBuilderFix;
+var
+ Proc: function(const OldValue: string; const NewValue: string; StartIndex: Integer; Count: Integer): TStringBuilder of object;
+begin
+ DebugLog('StringBuilderFix');
+ Proc := TStringBuilder(nil).Replace;
+ HookProc(TMethod(Proc).Code, @TStringBuilderFix.Replace, TStringBuilder_ReplaceHook);
+end;
+
+procedure FiniStringBuilderFix;
+var
+ Proc: function(const OldValue: string; const NewValue: string; StartIndex: Integer; Count: Integer): TStringBuilder of object;
+begin
+ Proc := TStringBuilder(nil).Replace;
+ UnhookProc(TMethod(Proc).Code, TStringBuilder_ReplaceHook);
+end;
+{$ENDIF StringBuilderFix}
+{ ---------------------------------------------------------------------------- }
+
+
+{ ---------------------------------------------------------------------------- }
+{ Workaround for Windows Vista CompareString bug }
+{$IFDEF VistaCompareStringFix}
+
+{**************************************************************************************************}
+{ }
+{ CompareString Fix }
+{ }
+{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
+{ you may not use this file except in compliance with the License. You may obtain a copy of the }
+{ License at http://www.mozilla.org/MPL/ }
+{ }
+{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
+{ ANY KIND, either express or implied. See the License for the specific language governing rights }
+{ and limitations under the License. }
+{ }
+{ The Original Code is CompareStringFix.pas. }
+{ }
+{ The Initial Developer of the Original Code is Andreas Hausladen. }
+{ Portions created by Andreas Hausladen are Copyright (C) 2008 Andreas Hausladen. }
+{ All Rights Reserved. }
+{ }
+{ Contributor(s): }
+{ Apr 18, 2008 A. Garrels - When parameter Locale or user default LCID matches (German-Germany) }
+{ and sort order equals SORT_GERMAN_PHONE_BOOK the patch must not be applied. }
+{ }
+{**************************************************************************************************}
+{ This unit contains a workaround for a Windows Vista bug. }
+{ The Ü/ü ($DC/$FC) and the UE/ue are treated equal in all locales, but they aren't equal. There }
+{ was a bugfix intended for Vista SP1 but it was removed before SP1 was released. }
+{ Windows 2008 Server still includes this bugfix but Vista will never get this bugfix. }
+{ Microsoft: new versions are for correctness; service packs are for consistency and compatibility }
+{**************************************************************************************************}
+
+function _CompareStringA(Locale: LCID; dwCmpFlags: DWORD; lpString1: PAnsiChar;
+ cchCount1: Integer; lpString2: PAnsiChar; cchCount2: Integer): Integer; stdcall;
+ external kernel32 name 'CompareStringA';
+function _CompareStringW(Locale: LCID; dwCmpFlags: DWORD; lpString1: PWideChar;
+ cchCount1: Integer; lpString2: PWideChar; cchCount2: Integer): Integer; stdcall;
+ external kernel32 name 'CompareStringW';
+
+var
+ CompareStringAProc: function(Locale: LCID; dwCmpFlags: DWORD; lpString1: PAnsiChar;
+ cchCount1: Integer; lpString2: PAnsiChar; cchCount2: Integer): Integer; stdcall;
+ CompareStringWProc: function(Locale: LCID; dwCmpFlags: DWORD; lpString1: PWideChar;
+ cchCount1: Integer; lpString2: PWideChar; cchCount2: Integer): Integer; stdcall;
+ CompareStringFixRequired: Boolean;
+
+const
+ MaxCompareStringFixBuffer = 2047;
+var
+ CachedUserDefaultLCID: LCID = 0;
+ CachedSystemDefaultLCID: LCID = 0;
+
+function IsGermanPhonebookSortOrder(ALcid: LCID): Boolean; {$IF CompilerVersion >= 18.0} inline; {$IFEND}
+begin
+ if ALcid <> 0 then
+ begin
+ if ALcid = LOCALE_USER_DEFAULT then
+ begin
+ if CachedUserDefaultLCID = 0 then
+ CachedUserDefaultLCID := GetUserDefaultLCID();
+ ALcid := CachedUserDefaultLCID;
+ end
+ else if ALcid = LOCALE_SYSTEM_DEFAULT then
+ begin
+ if CachedSystemDefaultLCID = 0 then
+ CachedSystemDefaultLCID := GetSystemDefaultLCID();
+ ALcid := CachedSystemDefaultLCID;
+ end;
+
+ Result := (Word(ALcid) = $0407) and (ALcid shr 16 and $0F = SORT_GERMAN_PHONE_BOOK);
+ end
+ else
+ Result := False;
+end;
+
+function GetUmlautFixedString(P: PWideChar; var Count: Integer; Buf: PWideChar): PWideChar;
+const
+ CombiningDiaresis = $308;
+var
+ ValidCount, EndIndex, EndCount, I, CollationCount, Size, Cnt: Integer;
+ Ch: WideChar;
+ Source, Dest: PWideChar;
+begin
+ ValidCount := -1;
+ CollationCount := 0;
+ EndIndex := -1;
+ Source := P;
+
+ { Test for the affected code points }
+ if Count = -1 then
+ begin
+ Ch := Source^;
+ while Ch <> #0 do
+ begin
+ while Ch <> #0 do
+ begin
+ case Ch of
+ #$00DC, #$00FC:
+ Break;
+ end;
+ Inc(Source);
+ Ch := Source^;
+ end;
+
+ if Ch <> #0 then
+ begin
+ I := Source - P;
+ if ValidCount = -1 then
+ ValidCount := I;
+ EndIndex := I + 1;
+ Inc(CollationCount);
+ Inc(Source);
+ Ch := Source^;
+ end;
+ end;
+
+ Count := Source - P;
+ end
+ else
+ begin
+ Cnt := Count;
+ while Cnt > 0 do
+ begin
+ while Cnt <> 0 do
+ begin
+ case Source^ of
+ #$00DC, #$00FC:
+ Break;
+ end;
+ Inc(Source);
+ Dec(Cnt);
+ end;
+
+ if Cnt <> 0 then
+ begin
+ I := Source - P;
+ if ValidCount = -1 then
+ ValidCount := I;
+ EndIndex := I + 1;
+ Inc(CollationCount);
+ Inc(Source);
+ Dec(Cnt);
+ end;
+ end;
+ end;
+
+ if CollationCount > 0 then
+ begin
+ { Re-encode the string with combining diaresis }
+
+ EndCount := Count - EndIndex;
+ if EndCount < 4 then
+ begin
+ { Move() isn't faster if there are too less code points to copy }
+ EndIndex := Count;
+ EndCount := 0;
+ end;
+
+ { Allocate enough memory or use the stack based buffer if the string fits
+ into it. }
+ Inc(Count, CollationCount);
+ Size := (Count + 1) * SizeOf(WideChar);
+ if Count < MaxCompareStringFixBuffer then
+ Result := Buf
+ else
+ GetMem(Result, Size);
+
+ { Copy untouched code points }
+ if ValidCount >= 4 then
+ Move(P^, Result^, ValidCount * SizeOf(WideChar))
+ else
+ ValidCount := 0;
+
+ { Copy code points and replace "Ü" ($DC) and "ü" ($FC) with "U"/"u" + combining diaresis }
+ Source := P + ValidCount;
+ Dest := Result + ValidCount;
+ for I := ValidCount to EndIndex - 1 do
+ begin
+ Ch := Source^;
+ case Ch of
+ #$00DC:
+ begin
+ PLongint(Dest)^ := (CombiningDiaresis shl 16) or $55;
+ Inc(Dest);
+ end;
+ #$00FC:
+ begin
+ PLongint(Dest)^ := (CombiningDiaresis shl 16) or $75;
+ Inc(Dest);
+ end;
+ else
+ Dest^ := Ch;
+ end;
+ Inc(Dest);
+ Inc(Source);
+ end;
+
+ { Copy remaining untouched code points }
+ if EndCount > 0 then
+ begin
+ Move(Source^, Dest^, EndCount * SizeOf(WideChar));
+ Inc(Dest, EndCount);
+ end;
+ Dest^ := #0;
+ end
+ else
+ Result := P;
+end;
+
+function CompareStringW(Locale: LCID; dwCmpFlags: DWORD; lpString1: PWideChar;
+ cchCount1: Integer; lpString2: PWideChar; cchCount2: Integer): Integer; stdcall;
+var
+ String1, String2: PWideChar;
+ // Stack allocation is much faster than heap allocation
+ Buf1, Buf2: array[0..MaxCompareStringFixBuffer] of WideChar;
+begin
+ if (lpString1 <> nil) and (lpString2 <> nil) and (cchCount1 <> 0) and (cchCount2 <> 0) and
+ (lpString1 <> lpString2) and
+ not IsGermanPhonebookSortOrder(Locale) then
+ begin
+ String1 := GetUmlautFixedString(lpString1, cchCount1, Buf1);
+ String2 := GetUmlautFixedString(lpString2, cchCount2, Buf2);
+
+ Result := CompareStringWProc(Locale, dwCmpFlags, String1, cchCount1, String2, cchCount2);
+
+ if (String1 <> lpString1) and (String1 <> @Buf1[0]) then
+ FreeMem(String1);
+ if (String2 <> lpString2) and (String2 <> @Buf2[0]) then
+ FreeMem(String2);
+ end
+ else
+ Result := CompareStringWProc(Locale, dwCmpFlags, lpString1, cchCount1, lpString2, cchCount2);
+end;
+
+function CompareStringA(Locale: LCID; dwCmpFlags: DWORD; lpString1: PAnsiChar;
+ cchCount1: Integer; lpString2: PAnsiChar; cchCount2: Integer): Integer; stdcall;
+
+ function ContainsProblematicUmlaut(P: PAnsiChar; Count: Integer): Boolean;
+ begin
+ Result := True;
+ while Count > 0 do
+ begin
+ if P^ in [#$DC, #$FC] then
+ Exit;
+ Inc(P);
+ Dec(Count);
+ end;
+ Result := False;
+ end;
+
+var
+ String1, String2: WideString;
+begin
+ if (lpString1 <> nil) and (lpString2 <> nil) and (cchCount1 <> 0) and (cchCount2 <> 0) and
+ (lpString1 <> lpString2) and
+ not IsGermanPhonebookSortOrder(Locale) then
+ begin
+ case GetACP of
+ {1250,} 1252{, 1254, 1257, 1258}:
+ begin
+ if cchCount1 = -1 then
+ cchCount1 := StrLen(lpString1);
+ if cchCount2 = -1 then
+ cchCount2 := StrLen(lpString2);
+
+ if ContainsProblematicUmlaut(lpString1, cchCount1) or
+ ContainsProblematicUmlaut(lpString2, cchCount2) then
+ begin
+ SetString(String1, lpString1, cchCount1);
+ SetString(String2, lpString2, cchCount2);
+ Result := CompareStringW(Locale, dwCmpFlags, PWideChar(String1), Length(String1),
+ PWideChar(String2), Length(String2));
+ Exit;
+ end;
+ end;
+ end;
+ end;
+ Result := CompareStringAProc(Locale, dwCmpFlags, lpString1, cchCount1, lpString2, cchCount2);
+end;
+
+type
+ TJumpItem = packed record
+ Code: TXRedirCode;
+ Jump: Byte;
+ Offset: Integer;
+ end;
+ PJumpTable = ^TJumpTable;
+ TJumpTable = array[0..1] of TJumpItem;
+
+var
+ JumpTable: PJumpTable;
+
+procedure PatchWinAPI(Proc, Dest: Pointer; var JumpItem: TJumpItem);
+var
+ n: DWORD;
+ Code: TXRedirCode;
+begin
+ Proc := GetActualAddr(Proc);
+ Assert(Proc <> nil);
+
+ if ReadProcessMemory(GetCurrentProcess, Proc, @JumpItem.Code, SizeOf(JumpItem.Code), n) then
+ begin
+ JumpItem.Jump := $E9;
+ JumpItem.Offset := Integer(Proc) - Integer(@JumpItem) - SizeOf(JumpItem.Code);
+
+ Code.Jump := $E9;
+ Code.Offset := Integer(Dest) - Integer(Proc) - SizeOf(Code);
+
+ WriteProcessMemory(GetCurrentProcess, Proc, @Code, SizeOf(Code), n);
+ end;
+end;
+
+procedure UnpatchWinAPI(Proc: Pointer; const JumpItem: TJumpItem);
+var
+ n: Cardinal;
+begin
+ if JumpItem.Code.Jump <> 0 then
+ begin
+ Proc := GetActualAddr(Proc);
+ Assert(Proc <> nil);
+
+ WriteProcessMemory(GetCurrentProcess, Proc, @JumpItem.Code, SizeOf(JumpItem.Code), n);
+ end;
+end;
+
+procedure InitCompareStringFix;
+const
+ CSTR_EQUAL = 2;
+begin
+ { Only Vista is affected, Windows 2008 Server is not affected }
+ if (Win32Platform = VER_PLATFORM_WIN32_NT) and
+ (Win32MajorVersion = 6) and (Win32MinorVersion = 0) then
+ begin
+ CompareStringFixRequired := _CompareStringW(LOCALE_USER_DEFAULT, NORM_IGNORECASE, #$FC, 1, 'ue', 2) = CSTR_EQUAL;
+ if CompareStringFixRequired then
+ begin
+ OutputDebugStringW('Installing CompareString workaround for Windows Vista');
+ JumpTable := VirtualAlloc(nil, SizeOf(TJumpTable), MEM_COMMIT, PAGE_EXECUTE_READWRITE);
+
+ PatchWinAPI(@_CompareStringA, @CompareStringA, JumpTable[0]);
+ CompareStringAProc := @JumpTable[0];
+ PatchWinAPI(@_CompareStringW, @CompareStringW, JumpTable[1]);
+ CompareStringWProc := @JumpTable[1];
+ end;
+ end;
+end;
+
+procedure FiniCompareStringFix;
+begin
+ if CompareStringFixRequired then
+ begin
+ UnpatchWinAPI(@_CompareStringA, JumpTable[0]);
+ UnpatchWinAPI(@_CompareStringW, JumpTable[1]);
+
+ VirtualFree(JumpTable, 0, MEM_RELEASE);
+ JumpTable := nil;
+ end;
+end;
+{$ENDIF VistaCompareStringFix}
+{ ---------------------------------------------------------------------------- }
+
+
+initialization
+ {$IFDEF GetNonToolWindowPopupParentFix}
+ FixGetNonToolWindowPopupParent;
+ {$ENDIF GetNonToolWindowPopupParentFix}
+
+ {$IFDEF TaskModalDialogFix}
+ InitTaskModalDialogFix;
+ {$ENDIF TaskModalDialogFix}
+
+ {$IFDEF AppDeActivateZOrderFix}
+ InitAppDeActivateZOrderFix;
+ {$ENDIF AppDeActivateZOrderFix}
+
+ {$IFDEF HideStackTrashingFix}
+ FindTopMostWindowProc := GetAddrOfFindTopMostWindow;
+ if FindTopMostWindowProc <> nil then
+ begin
+ DebugLog('HideStackTrashingFix');
+ HookProc(FindTopMostWindowProc, @FindTopMostWindow, FindTopMostWindowHook);
+ end;
+ {$ENDIF HideStackTrashingFix}
+
+ {$IFDEF ControlResizeFix}
+ InitControlResizeFix;
+ {$ENDIF ControlResizeFix}
+
+ {$IFDEF ActionListAVFix}
+ InitActionListAVFix;
+ {$ENDIF ActionListAVFix}
+
+ {$IFDEF ContextMenuFix}
+ InitContextMenuFix;
+ {$ENDIF ContextMenuFix}
+
+ {$IFDEF ObjAutoDEPFix}
+ InitObjAutoDEPFix;
+ {$ENDIF ObjAutoDEPFix}
+
+ {$IFDEF AppMinimizeFix}
+ InitAppMinimizeFix;
+ {$ENDIF AppMinimizeFix}
+
+ {$IFDEF SysUtilsAbortFix}
+ InitSysUtilsAbortFix;
+ {$ENDIF SysUtilsAbortFix}
+
+ {$IFDEF CmdShowMinimizeFix}
+ InitCmdShowMinimizeFix;
+ {$ENDIF CmdShowMinimizeFix}
+
+ {$IFDEF MDIChildFocusFix}
+ InitMDIChildFocusFix;
+ {$ENDIF MDIChildFocusFix}
+
+ {$IFDEF PageControlPaintingFix}
+ InitPageControlPaintingFix;
+ {$ENDIF PageControlPaintingFix}
+
+ {$IFDEF GridFlickerFix}
+ InitGridFlickerFix;
+ {$ENDIF GridFlickerFix}
+
+ {$IFDEF SpeedButtonGlassFix}
+ InitSpeedButtonGlassFix;
+ {$ENDIF SpeedButtonGlassFix}
+
+ {$IFDEF VistaProgressBarMarqueeFix}
+ InitVistaProgressBarMarqueeFix;
+ {$ENDIF VistaProgressBarMarqueeFix}
+
+ {$IFDEF DBNavigatorFix}
+ InitDBNavigatorFix;
+ {$ENDIF DBNavigatorFix}
+
+ {$IFDEF CharacterFix}
+ InitCharacterFix;
+ {$ENDIF CharacterFix}
+
+ {$IFDEF StringBuilderFix}
+ InitStringBuilderFix;
+ {$ENDIF StringBuilderFix}
+
+ {$IFDEF VistaCompareStringFix}
+ InitCompareStringFix;
+ {$ENDIF VistaCompareStringFix}
+
+finalization
+ // In revers order
+
+ {$IFDEF VistaCompareStringFix}
+ FiniCompareStringFix;
+ {$ENDIF VistaCompareStringFix}
+
+ {$IFDEF StringBuilderFix}
+ FiniStringBuilderFix;
+ {$ENDIF StringBuilderFix}
+
+ {$IFDEF CharacterFix}
+ FiniCharacterFix;
+ {$ENDIF CharacterFix}
+
+ {$IFDEF DBNavigatorFix}
+ FiniDBNavigatorFix;
+ {$ENDIF DBNavigatorFix}
+
+ {$IFDEF VistaProgressBarMarqueeFix}
+ FiniVistaProgressBarMarqueeFix;
+ {$ENDIF VistaProgressBarMarqueeFix}
+
+ {$IFDEF SpeedButtonGlassFix}
+ FiniSpeedButtonGlassFix;
+ {$ENDIF SpeedButtonGlassFix}
+
+ {$IFDEF GridFlickerFix}
+ FiniGridFlickerFix;
+ {$ENDIF GridFlickerFix}
+
+ {$IFDEF PageControlPaintingFix}
+ FiniPageControlPaintingFix;
+ {$ENDIF PageControlPaintingFix}
+
+ {$IFDEF MDIChildFocusFix}
+ FiniMDIChildFocusFix;
+ {$ENDIF MDIChildFocusFix}
+
+ {$IFDEF CmdShowMinimizeFix}
+ FiniCmdShowMinimizeFix;
+ {$ENDIF CmdShowMinimizeFix}
+
+ {$IFDEF SysUtilsAbortFix}
+ FiniSysUtilsAbortFix;
+ {$ENDIF SysUtilsAbortFix}
+
+ {$IFDEF AppMinimizeFix}
+ FiniAppMinimizeFix;
+ {$ENDIF AppMinimizeFix}
+
+ {$IFDEF ObjAutoDEPFix}
+ FiniObjAutoDEPFix;
+ {$ENDIF ObjAutoDEPFix}
+
+ {$IFDEF ContextMenuFix}
+ FiniContextMenuFix;
+ {$ENDIF ContextMenuFix}
+
+ {$IFDEF ActionListAVFix}
+ FiniActionListAVFix;
+ {$ENDIF ActionListAVFix}
+
+ {$IFDEF ControlResizeFix}
+ FiniControlResizeFix;
+ {$ENDIF ControlResizeFix}
+
+ {$IFDEF HideStackTrashingFix}
+ if FindTopMostWindowProc <> nil then
+ UnhookProc(FindTopMostWindowProc, FindTopMostWindowHook);
+ {$ENDIF HideStackTrashingFix}
+
+ {$IFDEF TaskModalDialogFix}
+ FiniTaskModalDialogFix;
+ {$ENDIF TaskModalDialogFix}
+
+ {$IFDEF AppDeActivateZOrderFix}
+ FiniAppDeActivateZOrderFix;
+ {$ENDIF AppDeActivateZOrderFix}
+
+ {$IFDEF MkObjInstLeakFix}
+ MkObjInstLeakHooked := False;
+ ReleaseObjectInstanceBlocks;
+ {$ENDIF MkObjInstLeakFix}
+
+end.
diff --git a/Source/Cliente/uBootStrap.pas b/Source/Cliente/uBootStrap.pas
index ef56835a..9f9008f7 100644
--- a/Source/Cliente/uBootStrap.pas
+++ b/Source/Cliente/uBootStrap.pas
@@ -66,6 +66,11 @@ begin
end;
end;
+procedure DoRefreshMainForm;
+begin
+ fPantallaPrincipal.RefrescarUI;
+end;
+
procedure DoAppMainForm;
begin
Application.CreateForm(TfPantallaPrincipal, fPantallaPrincipal);
@@ -83,6 +88,7 @@ begin
AppSplashForm := TAppSplashForm.Create;
DoMainFormEvent := DoAppMainForm;
DoLoadModulesEvent := DoAppLoadModules;
+ DoRefreshMainFormEvent := DoRefreshMainForm;
end;
NavPaneController := TNavPaneController.Create;
diff --git a/Source/Cliente/uPantallaPrincipal.dfm b/Source/Cliente/uPantallaPrincipal.dfm
index a74adb1a..d41617ce 100644
--- a/Source/Cliente/uPantallaPrincipal.dfm
+++ b/Source/Cliente/uPantallaPrincipal.dfm
@@ -14,6 +14,7 @@ object fPantallaPrincipal: TfPantallaPrincipal
OldCreateOrder = False
Position = poScreenCenter
Visible = True
+ WindowState = wsMaximized
OnClose = FormClose
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
diff --git a/Source/Cliente/uPantallaPrincipal.pas b/Source/Cliente/uPantallaPrincipal.pas
index 67edda56..584d13ca 100644
--- a/Source/Cliente/uPantallaPrincipal.pas
+++ b/Source/Cliente/uPantallaPrincipal.pas
@@ -130,15 +130,15 @@ type
procedure ShowEmbedded(AEditor : ICustomEditor);
procedure ReleaseEmbedded;
procedure AplicarPerfil;
- procedure RefrescarUI;
procedure InicializarUI;
procedure OnThemeChange(Sender: TObject);
procedure ExecuteActionMenu(Sender : TObject);
//procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
protected
function GetWorkPanel : TWinControl;
- public
procedure CreateParams(var Params: TCreateParams);
+ public
+ procedure RefrescarUI;
function IsShortcut(var Message: TWMKey): Boolean; override;
procedure OnWorkPanelChanged(AEditor : ICustomEditor);
constructor Create(AOwner: TComponent); override;
@@ -194,16 +194,6 @@ end;
procedure TfPantallaPrincipal.FormShow(Sender: TObject);
begin
InicializarUI;
-
- { Go full screen }
- WindowState := wsMaximized;
- {ClientWidth := Screen.Width ;
- ClientHeight := Screen.Height;}
- Refresh;
-
- //Sacamos la lista de empresas para que el usuario elija con la que va a trabajar
- AppFactuGES.SeleccionarEmpresa;
- RefrescarUI;
end;
procedure TfPantallaPrincipal.RefrescarUI;
diff --git a/Source/GUIBase/GUIBase.dpk b/Source/GUIBase/GUIBase.dpk
index 9600a5ed..ce0f4dea 100644
Binary files a/Source/GUIBase/GUIBase.dpk and b/Source/GUIBase/GUIBase.dpk differ
diff --git a/Source/GUIBase/GUIBase.dproj b/Source/GUIBase/GUIBase.dproj
index a5a33a2b..49001543 100644
--- a/Source/GUIBase/GUIBase.dproj
+++ b/Source/GUIBase/GUIBase.dproj
@@ -58,41 +58,45 @@
MainSource
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+ TForm
+
TCustomEditor
diff --git a/Source/GUIBase/uDialogBase.dfm b/Source/GUIBase/uDialogBase.dfm
index e461fde9..b2946f59 100644
--- a/Source/GUIBase/uDialogBase.dfm
+++ b/Source/GUIBase/uDialogBase.dfm
@@ -3,9 +3,9 @@ object fDialogBase: TfDialogBase
Top = 0
BorderStyle = bsDialog
Caption = 'fDialogBase'
- ClientHeight = 430
- ClientWidth = 623
- Color = clWindow
+ ClientHeight = 442
+ ClientWidth = 625
+ Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
@@ -16,34 +16,37 @@ object fDialogBase: TfDialogBase
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
- object pnlBotones: TFlowPanel
+ object Bevel2: TBevel
Left = 0
- Top = 374
- Width = 623
- Height = 56
+ Top = 64
+ Width = 625
+ Height = 2
+ Align = alTop
+ Shape = bsTopLine
+ ExplicitWidth = 500
+ end
+ object Bevel3: TBevel
+ Left = 0
+ Top = 398
+ Width = 625
+ Height = 2
Align = alBottom
- FlowStyle = fsBottomTopRightLeft
- Padding.Left = 20
- Padding.Top = 20
- Padding.Right = 20
- Padding.Bottom = 15
- ParentBackground = False
+ Shape = bsTopLine
+ ExplicitTop = 369
+ ExplicitWidth = 500
+ end
+ object pnlBotones: TPanel
+ Left = 0
+ Top = 400
+ Width = 625
+ Height = 42
+ Align = alBottom
+ BevelOuter = bvNone
TabOrder = 0
- VerticalAlignment = taAlignTop
- object Button1: TButton
- Left = 527
- Top = 15
- Width = 75
- Height = 25
- Action = actCancelar
- Cancel = True
- ModalResult = 2
- TabOrder = 1
- end
- object Button2: TButton
+ object btnAceptar: TButton
AlignWithMargins = True
- Left = 437
- Top = 15
+ Left = 464
+ Top = 8
Width = 75
Height = 25
Margins.Left = 0
@@ -54,51 +57,82 @@ object fDialogBase: TfDialogBase
ModalResult = 1
TabOrder = 0
end
+ object btnCancelar: TButton
+ Left = 543
+ Top = 8
+ Width = 75
+ Height = 25
+ Action = actCancelar
+ Cancel = True
+ ModalResult = 2
+ TabOrder = 1
+ end
end
- object FlowPanel1: TFlowPanel
+ object pnlHeader: TPanel
Left = 0
Top = 0
- Width = 623
- Height = 374
- Align = alClient
- Padding.Left = 30
- Padding.Top = 30
- Padding.Right = 30
- Padding.Bottom = 30
- ParentColor = True
+ Width = 625
+ Height = 64
+ Align = alTop
+ BevelOuter = bvNone
+ Color = clWhite
+ Padding.Left = 25
+ Padding.Top = 8
+ Padding.Right = 25
+ Padding.Bottom = 8
+ ParentBackground = False
TabOrder = 1
- object lblInstruccion: TLabel
+ object lblTitle: TLabel
AlignWithMargins = True
- Left = 31
- Top = 31
- Width = 78
- Height = 19
+ Left = 25
+ Top = 8
+ Width = 575
+ Height = 13
Margins.Left = 0
Margins.Top = 0
Margins.Right = 0
- Margins.Bottom = 20
+ Margins.Bottom = 8
Align = alTop
- Caption = 'Instrucci'#243'n'
+ Caption = 'T'#237'tulo'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
- Font.Height = -16
+ Font.Height = -11
Font.Name = 'Tahoma'
- Font.Style = []
+ Font.Style = [fsBold]
ParentFont = False
+ ExplicitWidth = 32
end
- object Label2: TLabel
- Left = 31
- Top = 70
- Width = 571
- Height = 81
- Align = alTop
- AutoSize = False
- Caption = 'Comentarios'
+ object lblComments: TLabel
+ AlignWithMargins = True
+ Left = 50
+ Top = 29
+ Width = 550
+ Height = 27
+ Margins.Left = 25
+ Margins.Top = 0
+ Margins.Right = 0
+ Align = alClient
+ Caption = 'Bla Bla Bla'
+ ExplicitWidth = 48
+ ExplicitHeight = 13
end
end
- object ActionList1: TActionList
+ object pnlCuerpo: TPanel
+ Left = 0
+ Top = 66
+ Width = 625
+ Height = 332
+ Align = alClient
+ BevelOuter = bvNone
+ Padding.Left = 50
+ Padding.Top = 15
+ Padding.Right = 50
+ Padding.Bottom = 15
+ TabOrder = 2
+ end
+ object ActionListDialog: TActionList
Left = 16
- Top = 384
+ Top = 72
object actAceptar: TAction
Caption = '&Aceptar'
end
diff --git a/Source/GUIBase/uDialogBase.pas b/Source/GUIBase/uDialogBase.pas
index dffb39d9..9018958f 100644
--- a/Source/GUIBase/uDialogBase.pas
+++ b/Source/GUIBase/uDialogBase.pas
@@ -8,20 +8,28 @@ uses
type
TfDialogBase = class(TForm)
- pnlBotones: TFlowPanel;
- Button1: TButton;
- Button2: TButton;
- ActionList1: TActionList;
+ ActionListDialog: TActionList;
actAceptar: TAction;
actCancelar: TAction;
- FlowPanel1: TFlowPanel;
- lblInstruccion: TLabel;
- Label2: TLabel;
+ pnlBotones: TPanel;
+ btnAceptar: TButton;
+ btnCancelar: TButton;
+ pnlHeader: TPanel;
+ lblTitle: TLabel;
+ lblComments: TLabel;
+ Bevel3: TBevel;
+ Bevel2: TBevel;
+ pnlCuerpo: TPanel;
procedure FormShow(Sender: TObject);
- private
+ protected
+ function GetTextoComentarios: String;
+ function GetTextoTitulo: String;
+ procedure SetTextoComentarios(const Value: String);
+ procedure SetTextoTitulo(const Value: String);
{ Private declarations }
public
- { Public declarations }
+ property TextoComentarios : String read GetTextoComentarios write SetTextoComentarios;
+ property TextoTitulo : String read GetTextoTitulo write SetTextoTitulo;
end;
implementation
@@ -29,11 +37,31 @@ implementation
{$R *.dfm}
uses
- uDMBase, JvNavigationPane;
+ uDMBase;
procedure TfDialogBase.FormShow(Sender: TObject);
begin
- lblInstruccion.Font.Color := dmBase.StyleManager.Colors.HeaderColorTo;
+ lblTitle.Font.Color := dmBase.StyleManager.Colors.HeaderColorTo;
+end;
+
+function TfDialogBase.GetTextoComentarios: String;
+begin
+ Result := lblComments.Caption;
+end;
+
+function TfDialogBase.GetTextoTitulo: String;
+begin
+ Result := lblTitle.Caption;
+end;
+
+procedure TfDialogBase.SetTextoComentarios(const Value: String);
+begin
+ lblComments.Caption := Value;
+end;
+
+procedure TfDialogBase.SetTextoTitulo(const Value: String);
+begin
+ lblTitle.Caption := Value;
end;
end.
diff --git a/Source/GUIBase/uDialogElegirEMail.dfm b/Source/GUIBase/uDialogElegirEMail.dfm
index 5ff71d5f..b20fcd30 100644
--- a/Source/GUIBase/uDialogElegirEMail.dfm
+++ b/Source/GUIBase/uDialogElegirEMail.dfm
@@ -1,56 +1,73 @@
inherited fDialogElegirEMail: TfDialogElegirEMail
Caption = 'Elegir direcci'#243'n de correo electr'#243'nico'
- ClientHeight = 220
- ClientWidth = 533
+ ClientHeight = 267
+ ClientWidth = 531
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnDestroy = FormDestroy
- ExplicitWidth = 539
- ExplicitHeight = 252
+ ExplicitWidth = 537
+ ExplicitHeight = 299
PixelsPerInch = 96
TextHeight = 13
- inherited pnlBotones: TFlowPanel
- Top = 164
- Width = 533
- ExplicitTop = 164
- ExplicitWidth = 533
- inherited Button1: TButton
- Left = 437
- ExplicitLeft = 437
+ inherited Bevel2: TBevel
+ Width = 531
+ ExplicitWidth = 531
+ end
+ inherited Bevel3: TBevel
+ Top = 223
+ Width = 531
+ ExplicitTop = 206
+ ExplicitWidth = 628
+ end
+ inherited pnlBotones: TPanel
+ Top = 225
+ Width = 531
+ ExplicitTop = 225
+ ExplicitWidth = 531
+ inherited btnAceptar: TButton
+ Left = 369
+ Top = 6
+ ExplicitLeft = 369
+ ExplicitTop = 6
end
- inherited Button2: TButton
- Left = 347
- ExplicitLeft = 347
+ inherited btnCancelar: TButton
+ Left = 448
+ Top = 6
+ ExplicitLeft = 448
+ ExplicitTop = 6
end
end
- inherited FlowPanel1: TFlowPanel
- Width = 533
- Height = 164
- ExplicitWidth = 533
- ExplicitHeight = 164
- inherited lblInstruccion: TLabel
- Width = 411
+ inherited pnlHeader: TPanel
+ Width = 531
+ ExplicitWidth = 531
+ inherited lblTitle: TLabel
+ Width = 481
Caption = 'Indique la direcci'#243'n de correo electr'#243'nico del destinatario:'
- ExplicitWidth = 411
+ ExplicitWidth = 328
end
- inherited Label2: TLabel
- Height = 3
+ inherited lblComments: TLabel
+ Width = 456
Visible = False
- ExplicitHeight = 3
end
+ end
+ inherited pnlCuerpo: TPanel
+ Width = 531
+ Height = 157
+ ExplicitWidth = 531
+ ExplicitHeight = 157
object Panel1: TPanel
- Left = 31
- Top = 73
- Width = 482
- Height = 80
+ Left = 50
+ Top = 15
+ Width = 431
+ Height = 127
Align = alClient
BevelOuter = bvNone
ParentColor = True
TabOrder = 0
object rbCombo: TRadioButton
Tag = 1
- Left = 10
- Top = 6
+ Left = -1
+ Top = 17
Width = 170
Height = 17
Caption = 'Usar esta direcci'#243'n de correo:'
@@ -58,18 +75,18 @@ inherited fDialogElegirEMail: TfDialogElegirEMail
OnClick = rbComboClick
end
object cbEMail: TComboBox
- Left = 211
- Top = 6
- Width = 262
+ Left = 200
+ Top = 17
+ Width = 225
Height = 21
Style = csDropDownList
- ItemHeight = 0
+ ItemHeight = 13
TabOrder = 1
end
object rbEdit: TRadioButton
Tag = 2
- Left = 10
- Top = 41
+ Left = -1
+ Top = 52
Width = 202
Height = 17
Caption = 'Usar la siguiente direcci'#243'n de correo:'
@@ -77,8 +94,8 @@ inherited fDialogElegirEMail: TfDialogElegirEMail
OnClick = rbEditClick
end
object edtEMail: TcxHyperLinkEdit
- Left = 211
- Top = 39
+ Left = 200
+ Top = 50
Properties.UsePrefix = upNever
Properties.ValidateOnEnter = True
Properties.Prefix = ''
@@ -91,12 +108,11 @@ inherited fDialogElegirEMail: TfDialogElegirEMail
StyleHot.LookAndFeel.Kind = lfStandard
StyleHot.LookAndFeel.NativeStyle = True
TabOrder = 3
- Width = 262
+ Width = 225
end
end
end
- inherited ActionList1: TActionList
- Left = 8
+ inherited ActionListDialog: TActionList
Top = 8
inherited actAceptar: TAction
OnExecute = actAceptarExecute
diff --git a/Source/GUIBase/uEditorDBBase.pas b/Source/GUIBase/uEditorDBBase.pas
index 84cee110..72ad08c1 100644
--- a/Source/GUIBase/uEditorDBBase.pas
+++ b/Source/GUIBase/uEditorDBBase.pas
@@ -8,9 +8,8 @@ uses
TB2Item, TB2Dock, TB2Toolbar, ComCtrls, JvExControls, JvComponent,
JvNavigationPane, DB, uDADataTable, uEditorBase, JvFormAutoSize,
uDAScriptingProvider, uDACDSDataTable, AppEvnts, uCustomView, uViewBase,
- JvAppStorage, JvAppRegistryStorage, JvFormPlacement,
- pngimage, ExtCtrls, dxLayoutLookAndFeels, JvComponentBase, TBXStatusBars,
- JvExComCtrls, JvStatusBar, uDAInterfaces, JvgWizardHeader;
+ JvAppStorage, JvAppRegistryStorage, uDAInterfaces, JvComponentBase,
+ JvFormPlacement, JvExComCtrls, JvStatusBar, pngimage, ExtCtrls;
type
IEditorDBBase = interface(IEditorBase)
diff --git a/Source/GUIBase/uEditorDBItem.pas b/Source/GUIBase/uEditorDBItem.pas
index 3ff216c2..48098dc5 100644
--- a/Source/GUIBase/uEditorDBItem.pas
+++ b/Source/GUIBase/uEditorDBItem.pas
@@ -8,9 +8,8 @@ uses
TB2Item, TB2Dock, TB2Toolbar, ComCtrls, JvExControls, JvComponent,
JvNavigationPane, DB, uDADataTable, uEditorDBBase, JvFormAutoSize,
StdCtrls, uDAScriptingProvider, uDACDSDataTable, AppEvnts, uCustomView,
- uViewBase, JvAppStorage, JvAppRegistryStorage,
- JvFormPlacement, pngimage, ExtCtrls, JvComponentBase, dxLayoutLookAndFeels,
- JvExComCtrls, JvStatusBar, uDAInterfaces, JvgWizardHeader;
+ uViewBase, JvAppStorage, JvAppRegistryStorage, ExtCtrls, uDAInterfaces,
+ JvComponentBase, JvFormPlacement, JvExComCtrls, JvStatusBar, pngimage;
type
IEditorDBItem = interface(IEditorDBBase)
diff --git a/Source/GUIBase/uViewGridBase.pas b/Source/GUIBase/uViewGridBase.pas
index af6e93c6..6ae077e8 100644
--- a/Source/GUIBase/uViewGridBase.pas
+++ b/Source/GUIBase/uViewGridBase.pas
@@ -166,14 +166,14 @@ procedure Register;
implementation
uses
- CCReg, uDMBase, uDBSelectionListUtils, uSistemaFunc, SHFolder,
+ uDMBase, uDBSelectionListUtils, uSistemaFunc, SHFolder,
uAppInfoUtils, cxGridExportLink;
{$R *.dfm}
procedure Register;
begin
- RegisterCustomContainer(TfrViewGridBase);
+ //RegisterCustomContainer(TfrViewGridBase);
end;
{ TfrViewGrid }
diff --git a/Source/Modulos/Albaranes de cliente/Servidor/srvAlbaranesCliente_Impl.dfm b/Source/Modulos/Albaranes de cliente/Servidor/srvAlbaranesCliente_Impl.dfm
index 625170e9..0337d69e 100644
--- a/Source/Modulos/Albaranes de cliente/Servidor/srvAlbaranesCliente_Impl.dfm
+++ b/Source/Modulos/Albaranes de cliente/Servidor/srvAlbaranesCliente_Impl.dfm
@@ -1,8 +1,6 @@
object srvAlbaranesCliente: TsrvAlbaranesCliente
OldCreateOrder = True
OnCreate = DARemoteServiceCreate
- RequiresSession = True
- SessionManager = dmServer.SessionManager
ConnectionName = 'IBX'
ServiceSchema = schAlbaranesCliente
ServiceDataStreamer = Bin2DataStreamer
diff --git a/Source/Modulos/Albaranes de cliente/Servidor/srvAlbaranesCliente_Impl.pas b/Source/Modulos/Albaranes de cliente/Servidor/srvAlbaranesCliente_Impl.pas
index a7c96096..28dfe9c4 100644
--- a/Source/Modulos/Albaranes de cliente/Servidor/srvAlbaranesCliente_Impl.pas
+++ b/Source/Modulos/Albaranes de cliente/Servidor/srvAlbaranesCliente_Impl.pas
@@ -71,7 +71,7 @@ end;
procedure TsrvAlbaranesCliente.DARemoteServiceCreate(Sender: TObject);
begin
- SessionManager := dmServer.SessionManager;
+ //SessionManager := dmServer.SessionManager;
bpAlbaranesCliente.BusinessRulesID := BIZ_SERVER_ALBARAN_CLIENTE;
end;
diff --git a/Source/Modulos/Albaranes de cliente/Views/uEditorAlbaranesCliente.dfm b/Source/Modulos/Albaranes de cliente/Views/uEditorAlbaranesCliente.dfm
index 53e0775f..ebbb83c2 100644
--- a/Source/Modulos/Albaranes de cliente/Views/uEditorAlbaranesCliente.dfm
+++ b/Source/Modulos/Albaranes de cliente/Views/uEditorAlbaranesCliente.dfm
@@ -2,6 +2,7 @@ inherited fEditorAlbaranesCliente: TfEditorAlbaranesCliente
Caption = 'Lista de albaranes de cliente'
ClientWidth = 583
ExplicitWidth = 591
+ ExplicitHeight = 240
PixelsPerInch = 96
TextHeight = 13
inherited JvNavPanelHeader: TJvNavPanelHeader
diff --git a/Source/Modulos/Albaranes de cliente/Views/uEditorAlbaranesCliente.pas b/Source/Modulos/Albaranes de cliente/Views/uEditorAlbaranesCliente.pas
index c7338e61..fea01f7e 100644
--- a/Source/Modulos/Albaranes de cliente/Views/uEditorAlbaranesCliente.pas
+++ b/Source/Modulos/Albaranes de cliente/Views/uEditorAlbaranesCliente.pas
@@ -100,7 +100,6 @@ uses
}
procedure TfEditorAlbaranesCliente.actCancelarEnvioExecute(Sender: TObject);
begin
-AppFactuGES.ShowCapado;
{
inherited;
@@ -128,7 +127,6 @@ end;
procedure TfEditorAlbaranesCliente.actConfirmarRecepcionExecute(Sender: TObject);
begin
-AppFactuGES.ShowCapado;
{
inherited;
@@ -196,7 +194,6 @@ procedure TfEditorAlbaranesCliente.actEnviarExecute(Sender: TObject);
// AFacturasController : IFacturasClienteController;
// AAlbaran : IBizAlbaranCliente;
begin
-AppFactuGES.ShowCapado;
{
inherited;
bCambiarEstado := False;
diff --git a/Source/Modulos/Albaranes de cliente/Views/uEditorElegirAlbaranesCliente.dfm b/Source/Modulos/Albaranes de cliente/Views/uEditorElegirAlbaranesCliente.dfm
index 4a1ad303..fc52897e 100644
--- a/Source/Modulos/Albaranes de cliente/Views/uEditorElegirAlbaranesCliente.dfm
+++ b/Source/Modulos/Albaranes de cliente/Views/uEditorElegirAlbaranesCliente.dfm
@@ -1,43 +1,12 @@
inherited fEditorElegirAlbaranesCliente: TfEditorElegirAlbaranesCliente
- Caption = 'Seleccionar albar'#195#161'n de cliente'
+ Caption = 'Seleccionar albar'#225'n de cliente'
ClientWidth = 790
ExplicitWidth = 798
+ ExplicitHeight = 478
PixelsPerInch = 96
TextHeight = 13
- object JvgWizardHeader1: TJvgWizardHeader [0]
- Left = 0
- Top = 27
- Width = 790
- Height = 60
- CaptionFont.Charset = DEFAULT_CHARSET
- CaptionFont.Color = clWindowText
- CaptionFont.Height = -11
- CaptionFont.Name = 'Tahoma'
- CaptionFont.Style = [fsBold]
- CommentFont.Charset = DEFAULT_CHARSET
- CommentFont.Color = clWindowText
- CommentFont.Height = -11
- CommentFont.Name = 'Tahoma'
- CommentFont.Style = []
- SymbolFont.Charset = DEFAULT_CHARSET
- SymbolFont.Color = clHighlightText
- SymbolFont.Height = -35
- SymbolFont.Name = 'Wingdings'
- SymbolFont.Style = [fsBold]
- Captions.Strings = (
- 'Seleccione el albar'#225'n de cliente')
- Comments.Strings = (
- ' ')
- Gradient.FromColor = clHighlight
- Gradient.ToColor = clWindow
- Gradient.Active = False
- Gradient.Orientation = fgdVertical
- BufferedDraw = False
- ExplicitLeft = -8
- ExplicitTop = 8
- ExplicitWidth = 656
- end
inherited JvNavPanelHeader: TJvNavPanelHeader
+ Top = 64
Width = 790
Visible = False
ExplicitWidth = 790
@@ -47,12 +16,11 @@ inherited fEditorElegirAlbaranesCliente: TfEditorElegirAlbaranesCliente
end
end
inherited TBXDock: TTBXDock
- Top = 87
+ Top = 91
Width = 790
- ExplicitTop = 87
ExplicitWidth = 790
inherited tbxMain: TTBXToolbar
- ExplicitWidth = 126
+ ExplicitWidth = 263
inherited TBXItem2: TTBXItem
Visible = False
end
@@ -97,13 +65,13 @@ inherited fEditorElegirAlbaranesCliente: TfEditorElegirAlbaranesCliente
end
end
inherited tbxFiltro: TTBXToolbar
- Left = 126
+ Left = 263
Top = 23
DockPos = 104
DockRow = 1
- ExplicitLeft = 126
+ ExplicitLeft = 263
ExplicitTop = 23
- ExplicitWidth = 269
+ ExplicitWidth = 363
inherited TBXItem34: TTBXItem
Action = actQuitarFiltro2
end
@@ -125,7 +93,7 @@ inherited fEditorElegirAlbaranesCliente: TfEditorElegirAlbaranesCliente
Width = 790
ExplicitWidth = 790
end
- inline frViewBarraSeleccion1: TfrViewBarraSeleccion [4]
+ inline frViewBarraSeleccion1: TfrViewBarraSeleccion [3]
Left = 0
Top = 389
Width = 790
@@ -170,6 +138,55 @@ inherited fEditorElegirAlbaranesCliente: TfEditorElegirAlbaranesCliente
end
end
end
+ object pnlHeader: TPanel [4]
+ Left = 0
+ Top = 0
+ Width = 790
+ Height = 64
+ Align = alTop
+ BevelOuter = bvNone
+ Color = clWhite
+ Padding.Left = 25
+ Padding.Top = 8
+ Padding.Right = 25
+ Padding.Bottom = 8
+ ParentBackground = False
+ TabOrder = 4
+ ExplicitLeft = 8
+ ExplicitTop = -37
+ object lblTitle: TLabel
+ AlignWithMargins = True
+ Left = 25
+ Top = 8
+ Width = 740
+ Height = 13
+ Margins.Left = 0
+ Margins.Top = 0
+ Margins.Right = 0
+ Margins.Bottom = 8
+ Align = alTop
+ Caption = 'Seleccione el albar'#225'n de cliente'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = [fsBold]
+ ParentFont = False
+ ExplicitWidth = 177
+ end
+ object lblComments: TLabel
+ AlignWithMargins = True
+ Left = 50
+ Top = 29
+ Width = 715
+ Height = 27
+ Margins.Left = 25
+ Margins.Top = 0
+ Margins.Right = 0
+ Align = alClient
+ ExplicitTop = 0
+ end
+ end
inherited EditorActionList: TActionList [5]
end
inherited SmallImages: TPngImageList [6]
@@ -192,8 +209,6 @@ inherited fEditorElegirAlbaranesCliente: TfEditorElegirAlbaranesCliente
end
inherited JsNuevoAlbaranDialog: TJSDialog [13]
end
- inherited JsImprimirDialog: TJSDialog [15]
- end
object EditorSeleccionActionList: TActionList
Images = SmallImages
Left = 152
diff --git a/Source/Modulos/Albaranes de cliente/Views/uEditorElegirAlbaranesCliente.pas b/Source/Modulos/Albaranes de cliente/Views/uEditorElegirAlbaranesCliente.pas
index 4ce9e0a5..cfe40424 100644
--- a/Source/Modulos/Albaranes de cliente/Views/uEditorElegirAlbaranesCliente.pas
+++ b/Source/Modulos/Albaranes de cliente/Views/uEditorElegirAlbaranesCliente.pas
@@ -9,18 +9,20 @@ uses
ActnList, uCustomView, uViewBase, uViewGridBase, uViewGrid,
uViewAlbaranesCliente, ComCtrls, TB2ExtItems, TBXExtItems, TBX,
TB2Item, TB2Dock, TB2Toolbar, pngimage, ExtCtrls, JvExControls, JvComponent,
- JvNavigationPane, uViewBarraSeleccion, JvgWizardHeader, StdCtrls,
+ JvNavigationPane, uViewBarraSeleccion, StdCtrls,
uEditorAlbaranesCliente, uBizAlbaranesCliente, uIEditorElegirAlbaranesCliente,
- JvExComCtrls, JvStatusBar, JSDialog;
+ JvExComCtrls, JvStatusBar, JSDialog, uDAInterfaces;
type
TfEditorElegirAlbaranesCliente = class(TfEditorAlbaranesCliente, IEditorElegirAlbaranesCliente)
frViewBarraSeleccion1: TfrViewBarraSeleccion;
- JvgWizardHeader1: TJvgWizardHeader;
EditorSeleccionActionList: TActionList;
actBuscar2: TAction;
actQuitarFiltro2: TAction;
actAnchoAuto2: TAction;
+ pnlHeader: TPanel;
+ lblTitle: TLabel;
+ lblComments: TLabel;
procedure frViewBarraSeleccion1actSeleccionarUpdate(Sender: TObject);
procedure frViewBarraSeleccion1actCancelarExecute(Sender: TObject);
procedure frViewBarraSeleccion1actSeleccionarExecute(Sender: TObject);
@@ -97,12 +99,12 @@ end;
function TfEditorElegirAlbaranesCliente.GetMensaje: String;
begin
- Result := JvgWizardHeader1.Comments.Text;
+ Result := lblComments.Caption;
end;
procedure TfEditorElegirAlbaranesCliente.SetMensaje(const AValue: String);
begin
- JvgWizardHeader1.Comments.Text := AValue;
+ lblComments.Caption := AValue;
end;
procedure TfEditorElegirAlbaranesCliente.SetViewGrid(const Value: IViewGridBase);
diff --git a/Source/Modulos/Albaranes de cliente/Views/uEditorElegirArticulosAlbaranCliente.dfm b/Source/Modulos/Albaranes de cliente/Views/uEditorElegirArticulosAlbaranCliente.dfm
index cd358ae6..bf4f09a0 100644
--- a/Source/Modulos/Albaranes de cliente/Views/uEditorElegirArticulosAlbaranCliente.dfm
+++ b/Source/Modulos/Albaranes de cliente/Views/uEditorElegirArticulosAlbaranCliente.dfm
@@ -1,6 +1,14 @@
inherited fEditorElegirArticulosAlbaranCliente: TfEditorElegirArticulosAlbaranCliente
Caption = 'fEditorElegirArticulosAlbaranCliente'
- ExplicitHeight = 478
PixelsPerInch = 96
TextHeight = 13
+ inherited pnlHeader: TPanel
+ inherited lblTitle: TLabel
+ Width = 606
+ end
+ inherited lblComments: TLabel
+ Width = 581
+ Height = 27
+ end
+ end
end
diff --git a/Source/Modulos/Albaranes de cliente/Views/uEditorElegirArticulosAlbaranCliente.pas b/Source/Modulos/Albaranes de cliente/Views/uEditorElegirArticulosAlbaranCliente.pas
index f24de4be..926db93c 100644
--- a/Source/Modulos/Albaranes de cliente/Views/uEditorElegirArticulosAlbaranCliente.pas
+++ b/Source/Modulos/Albaranes de cliente/Views/uEditorElegirArticulosAlbaranCliente.pas
@@ -9,7 +9,8 @@ uses
StdActns, ActnList, uCustomView, uViewBase, uViewBarraSeleccion, ComCtrls,
JvExComCtrls, JvStatusBar, TBX, TB2ExtItems, TBXExtItems, TB2Item, TB2Dock,
TB2Toolbar, pngimage, ExtCtrls, JvExControls, JvComponent, JvNavigationPane,
- JvgWizardHeader, uIEditorElegirArticulosAlbaranesCliente, uDAInterfaces;
+ uIEditorElegirArticulosAlbaranesCliente, uDAInterfaces,
+ StdCtrls;
type
TfEditorElegirArticulosAlbaranCliente = class(TfEditorElegirArticulos, IEditorElegirArticulosAlbaranesCliente)
diff --git a/Source/Modulos/Albaranes de proveedor/Servidor/srvAlbaranesProveedor_Impl.dfm b/Source/Modulos/Albaranes de proveedor/Servidor/srvAlbaranesProveedor_Impl.dfm
index 60c7dab4..0cc2a372 100644
--- a/Source/Modulos/Albaranes de proveedor/Servidor/srvAlbaranesProveedor_Impl.dfm
+++ b/Source/Modulos/Albaranes de proveedor/Servidor/srvAlbaranesProveedor_Impl.dfm
@@ -1,8 +1,6 @@
object srvAlbaranesProveedor: TsrvAlbaranesProveedor
OldCreateOrder = True
OnCreate = DARemoteServiceCreate
- RequiresSession = True
- SessionManager = dmServer.SessionManager
ConnectionName = 'IBX'
ServiceSchema = schAlbaranesProveedor
ServiceDataStreamer = Bin2DataStreamer
diff --git a/Source/Modulos/Albaranes de proveedor/Servidor/srvAlbaranesProveedor_Impl.pas b/Source/Modulos/Albaranes de proveedor/Servidor/srvAlbaranesProveedor_Impl.pas
index 2f826c39..4c6fd6e1 100644
--- a/Source/Modulos/Albaranes de proveedor/Servidor/srvAlbaranesProveedor_Impl.pas
+++ b/Source/Modulos/Albaranes de proveedor/Servidor/srvAlbaranesProveedor_Impl.pas
@@ -69,7 +69,7 @@ end;
procedure TsrvAlbaranesProveedor.DARemoteServiceCreate(Sender: TObject);
begin
- SessionManager := dmServer.SessionManager;
+ //SessionManager := dmServer.SessionManager;
bpAlbaranesProveedor.BusinessRulesID := BIZ_SERVER_ALBARAN_PROVEEDOR;
end;
diff --git a/Source/Modulos/Albaranes de proveedor/Views/uEditorAlbaranProveedor.pas b/Source/Modulos/Albaranes de proveedor/Views/uEditorAlbaranProveedor.pas
index d54fd26a..f0ed548d 100644
--- a/Source/Modulos/Albaranes de proveedor/Views/uEditorAlbaranProveedor.pas
+++ b/Source/Modulos/Albaranes de proveedor/Views/uEditorAlbaranProveedor.pas
@@ -218,7 +218,6 @@ end;
procedure TfEditorAlbaranProveedor.ImprimirInterno;
begin
-AppFactuGES.ShowCapado;
{
inherited;
FController.Print(FAlbaran);
@@ -272,7 +271,6 @@ end;
procedure TfEditorAlbaranProveedor.PrevisualizarInterno;
begin
-AppFactuGES.ShowCapado;
{
inherited;
FController.Preview(FAlbaran);
diff --git a/Source/Modulos/Albaranes de proveedor/Views/uEditorAlbaranesProveedor.pas b/Source/Modulos/Albaranes de proveedor/Views/uEditorAlbaranesProveedor.pas
index 4ee8b31c..68366a0e 100644
--- a/Source/Modulos/Albaranes de proveedor/Views/uEditorAlbaranesProveedor.pas
+++ b/Source/Modulos/Albaranes de proveedor/Views/uEditorAlbaranesProveedor.pas
@@ -78,7 +78,6 @@ end;
procedure TfEditorAlbaranesProveedor.actGenerarFacturaExecute(Sender: TObject);
begin
-AppFactuGES.ShowCapado;
{
inherited;
// GenerarFacturaProv(Albaranes.ID);
@@ -117,7 +116,6 @@ procedure TfEditorAlbaranesProveedor.DuplicarInterno;
var
AAlbaran : IBizAlbaranProveedor;
begin
-AppFactuGES.ShowCapado;
{
inherited;
AAlbaran := FController.Duplicar(Albaranes);
@@ -200,13 +198,12 @@ begin
end;
procedure TfEditorAlbaranesProveedor.ImprimirInterno;
-var
+{var
Respuesta : Integer;
AAlbaranes: IBizAlbaranProveedor;
AllItems: Boolean;
-
+}
begin
-AppFactuGES.ShowCapado;
{
AAlbaranes := Nil;
AllItems := False;
@@ -292,12 +289,11 @@ begin
end;
procedure TfEditorAlbaranesProveedor.PrevisualizarInterno;
-var
+{var
Respuesta : Integer;
AAlbaranes: IBizAlbaranProveedor;
- AllItems: Boolean;
+ AllItems: Boolean;}
begin
-AppFactuGES.ShowCapado;
{
AAlbaranes := Nil;
AllItems := False;
diff --git a/Source/Modulos/Albaranes de proveedor/Views/uEditorElegirAlbaranesProveedor.dfm b/Source/Modulos/Albaranes de proveedor/Views/uEditorElegirAlbaranesProveedor.dfm
index d3c801d4..15096416 100644
--- a/Source/Modulos/Albaranes de proveedor/Views/uEditorElegirAlbaranesProveedor.dfm
+++ b/Source/Modulos/Albaranes de proveedor/Views/uEditorElegirAlbaranesProveedor.dfm
@@ -5,40 +5,8 @@ inherited fEditorElegirAlbaranesProveedor: TfEditorElegirAlbaranesProveedor
ExplicitHeight = 478
PixelsPerInch = 96
TextHeight = 13
- object JvgWizardHeader1: TJvgWizardHeader [0]
- Left = 0
- Top = 27
- Width = 790
- Height = 60
- CaptionFont.Charset = DEFAULT_CHARSET
- CaptionFont.Color = clWindowText
- CaptionFont.Height = -11
- CaptionFont.Name = 'Tahoma'
- CaptionFont.Style = [fsBold]
- CommentFont.Charset = DEFAULT_CHARSET
- CommentFont.Color = clWindowText
- CommentFont.Height = -11
- CommentFont.Name = 'Tahoma'
- CommentFont.Style = []
- SymbolFont.Charset = DEFAULT_CHARSET
- SymbolFont.Color = clHighlightText
- SymbolFont.Height = -35
- SymbolFont.Name = 'Wingdings'
- SymbolFont.Style = [fsBold]
- Captions.Strings = (
- 'Seleccione el albar'#225'n de proveedor')
- Comments.Strings = (
- ' ')
- Gradient.FromColor = clHighlight
- Gradient.ToColor = clWindow
- Gradient.Active = False
- Gradient.Orientation = fgdVertical
- BufferedDraw = False
- ExplicitLeft = -8
- ExplicitTop = 8
- ExplicitWidth = 656
- end
inherited JvNavPanelHeader: TJvNavPanelHeader
+ Top = 64
Width = 790
Visible = False
ExplicitWidth = 790
@@ -48,14 +16,11 @@ inherited fEditorElegirAlbaranesProveedor: TfEditorElegirAlbaranesProveedor
end
end
inherited TBXDock: TTBXDock
- Top = 87
+ Top = 91
Width = 790
- Height = 49
- ExplicitTop = 87
ExplicitWidth = 790
- ExplicitHeight = 49
inherited tbxMain: TTBXToolbar
- ExplicitWidth = 117
+ ExplicitWidth = 421
inherited TBXItem2: TTBXItem
Visible = False
end
@@ -91,11 +56,11 @@ inherited fEditorElegirAlbaranesProveedor: TfEditorElegirAlbaranesProveedor
end
end
inherited tbxFiltro: TTBXToolbar
- Left = 117
+ Left = 421
Top = 23
DockPos = 104
DockRow = 1
- ExplicitLeft = 117
+ ExplicitLeft = 421
ExplicitTop = 23
inherited TBXItem34: TTBXItem
Action = actQuitarFiltro2
@@ -104,13 +69,16 @@ inherited fEditorElegirAlbaranesProveedor: TfEditorElegirAlbaranesProveedor
inherited tbxMenu: TTBXToolbar
ExplicitWidth = 790
end
+ inherited TBXTMain2: TTBXToolbar
+ Left = 334
+ ExplicitLeft = 334
+ end
end
inherited StatusBar: TJvStatusBar
Width = 790
- ExplicitTop = 425
ExplicitWidth = 790
end
- inline frViewBarraSeleccion1: TfrViewBarraSeleccion [4]
+ inline frViewBarraSeleccion1: TfrViewBarraSeleccion [3]
Left = 0
Top = 389
Width = 790
@@ -155,6 +123,56 @@ inherited fEditorElegirAlbaranesProveedor: TfEditorElegirAlbaranesProveedor
end
end
end
+ object pnlHeader: TPanel [4]
+ Left = 0
+ Top = 0
+ Width = 790
+ Height = 64
+ Align = alTop
+ BevelOuter = bvNone
+ Color = clWhite
+ Padding.Left = 25
+ Padding.Top = 8
+ Padding.Right = 25
+ Padding.Bottom = 8
+ ParentBackground = False
+ TabOrder = 4
+ ExplicitLeft = -8
+ ExplicitTop = -37
+ object lblTitle: TLabel
+ AlignWithMargins = True
+ Left = 25
+ Top = 8
+ Width = 740
+ Height = 13
+ Margins.Left = 0
+ Margins.Top = 0
+ Margins.Right = 0
+ Margins.Bottom = 8
+ Align = alTop
+ Caption = 'Seleccione el albar'#225'n de proveedor'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = [fsBold]
+ ParentFont = False
+ ExplicitWidth = 198
+ end
+ object lblComments: TLabel
+ AlignWithMargins = True
+ Left = 50
+ Top = 29
+ Width = 715
+ Height = 27
+ Margins.Left = 25
+ Margins.Top = 0
+ Margins.Right = 0
+ Align = alClient
+ ExplicitWidth = 3
+ ExplicitHeight = 13
+ end
+ end
inherited EditorActionList: TActionList [5]
end
inherited SmallImages: TPngImageList [6]
@@ -169,12 +187,18 @@ inherited fEditorElegirAlbaranesProveedor: TfEditorElegirAlbaranesProveedor
Left = 16
Top = 168
end
- inherited StatusBarImages: TPngImageList [11]
- end
inherited GridPopupMenu: TPopupMenu
Left = 56
Top = 192
end
+ inherited StatusBarImages: TPngImageList [12]
+ end
+ inherited JsNuevoAlbaranDialog: TJSDialog [13]
+ end
+ inherited JsPrevisualizarDialog: TJSDialog [14]
+ end
+ inherited JsImprimirDialog: TJSDialog [15]
+ end
object EditorSeleccionActionList: TActionList
Images = SmallImages
Left = 152
diff --git a/Source/Modulos/Albaranes de proveedor/Views/uEditorElegirAlbaranesProveedor.pas b/Source/Modulos/Albaranes de proveedor/Views/uEditorElegirAlbaranesProveedor.pas
index 2fb48f47..f880b281 100644
--- a/Source/Modulos/Albaranes de proveedor/Views/uEditorElegirAlbaranesProveedor.pas
+++ b/Source/Modulos/Albaranes de proveedor/Views/uEditorElegirAlbaranesProveedor.pas
@@ -9,18 +9,20 @@ uses
ActnList, uCustomView, uViewBase, uViewGridBase, uViewGrid,
uViewAlbaranesProveedor, ComCtrls, TB2ExtItems, TBXExtItems, TBX,
TB2Item, TB2Dock, TB2Toolbar, pngimage, ExtCtrls, JvExControls, JvComponent,
- JvNavigationPane, uViewBarraSeleccion, JvgWizardHeader, StdCtrls,
+ JvNavigationPane, uViewBarraSeleccion, StdCtrls,
uEditorAlbaranesProveedor, uBizAlbaranesProveedor, uIEditorElegirAlbaranesProveedor,
- JvExComCtrls, JvStatusBar, JSDialog;
+ JvExComCtrls, JvStatusBar, JSDialog, uDAInterfaces;
type
TfEditorElegirAlbaranesProveedor = class(TfEditorAlbaranesProveedor, IEditorElegirAlbaranesProveedor)
frViewBarraSeleccion1: TfrViewBarraSeleccion;
- JvgWizardHeader1: TJvgWizardHeader;
EditorSeleccionActionList: TActionList;
actBuscar2: TAction;
actQuitarFiltro2: TAction;
actAnchoAuto2: TAction;
+ pnlHeader: TPanel;
+ lblTitle: TLabel;
+ lblComments: TLabel;
procedure frViewBarraSeleccion1actSeleccionarUpdate(Sender: TObject);
procedure frViewBarraSeleccion1actCancelarExecute(Sender: TObject);
procedure frViewBarraSeleccion1actSeleccionarExecute(Sender: TObject);
@@ -98,7 +100,7 @@ end;
function TfEditorElegirAlbaranesProveedor.GetMensaje: String;
begin
- Result := JvgWizardHeader1.Comments.Text;
+ Result := lblComments.Caption;
end;
function TfEditorElegirAlbaranesProveedor.GetMultiSelect: Boolean;
@@ -108,7 +110,7 @@ end;
procedure TfEditorElegirAlbaranesProveedor.SetMensaje(const AValue: String);
begin
- JvgWizardHeader1.Comments.Text := AValue;
+ lblComments.Caption := AValue;
end;
procedure TfEditorElegirAlbaranesProveedor.SetMultiSelect(AValue: Boolean);
diff --git a/Source/Modulos/Albaranes de proveedor/Views/uEditorElegirArticulosAlbaranProveedor.pas b/Source/Modulos/Albaranes de proveedor/Views/uEditorElegirArticulosAlbaranProveedor.pas
index 2851ce73..c93dadfa 100644
--- a/Source/Modulos/Albaranes de proveedor/Views/uEditorElegirArticulosAlbaranProveedor.pas
+++ b/Source/Modulos/Albaranes de proveedor/Views/uEditorElegirArticulosAlbaranProveedor.pas
@@ -9,7 +9,7 @@ uses
StdActns, ActnList, uCustomView, uViewBase, uViewBarraSeleccion, ComCtrls,
JvExComCtrls, JvStatusBar, TBX, TB2ExtItems, TBXExtItems, TB2Item, TB2Dock,
TB2Toolbar, pngimage, ExtCtrls, JvExControls, JvComponent, JvNavigationPane,
- JvgWizardHeader, uIEditorElegirArticulosAlbaranesProveedor, uBizContactos;
+ uIEditorElegirArticulosAlbaranesProveedor, uBizContactos;
type
TfEditorElegirArticulosAlbaranProveedor = class(TfEditorElegirArticulos, IEditorElegirArticulosAlbaranesProveedor)
diff --git a/Source/Modulos/Almacenes/Servidor/srvAlmacenes_Impl.dfm b/Source/Modulos/Almacenes/Servidor/srvAlmacenes_Impl.dfm
index 02977aca..5c1340b7 100644
--- a/Source/Modulos/Almacenes/Servidor/srvAlmacenes_Impl.dfm
+++ b/Source/Modulos/Almacenes/Servidor/srvAlmacenes_Impl.dfm
@@ -1,8 +1,6 @@
object srvAlmacenes: TsrvAlmacenes
OldCreateOrder = True
OnCreate = DARemoteServiceCreate
- RequiresSession = True
- SessionManager = dmServer.SessionManager
ConnectionName = 'IBX'
ServiceSchema = schAlmacenes
ServiceDataStreamer = Bin2DataStreamer
diff --git a/Source/Modulos/Almacenes/Servidor/srvAlmacenes_Impl.pas b/Source/Modulos/Almacenes/Servidor/srvAlmacenes_Impl.pas
index 0f9b948e..fd79df76 100644
--- a/Source/Modulos/Almacenes/Servidor/srvAlmacenes_Impl.pas
+++ b/Source/Modulos/Almacenes/Servidor/srvAlmacenes_Impl.pas
@@ -60,7 +60,7 @@ end;
procedure TsrvAlmacenes.DARemoteServiceCreate(Sender: TObject);
begin
- SessionManager := dmServer.SessionManager;
+ //SessionManager := dmServer.SessionManager;
end;
procedure TsrvAlmacenes.DataAbstractServiceBeforeAcquireConnection(
diff --git a/Source/Modulos/Almacenes/Views/uEditorAlmacenes.pas b/Source/Modulos/Almacenes/Views/uEditorAlmacenes.pas
index d91ac036..573423b7 100644
--- a/Source/Modulos/Almacenes/Views/uEditorAlmacenes.pas
+++ b/Source/Modulos/Almacenes/Views/uEditorAlmacenes.pas
@@ -119,10 +119,9 @@ begin
end;
procedure TfEditorAlmacenes.DuplicarInterno;
-var
- AAlmacen : IBizAlmacen;
+{var
+ AAlmacen : IBizAlmacen;}
begin
-AppFactuGES.ShowCapado;
{
inherited;
AAlmacen := FController.Duplicar(Almacenes);
diff --git a/Source/Modulos/Articulos/Plugin/Articulos_plugin.dpk b/Source/Modulos/Articulos/Plugin/Articulos_plugin.dpk
index bf6268f0..d3304256 100644
Binary files a/Source/Modulos/Articulos/Plugin/Articulos_plugin.dpk and b/Source/Modulos/Articulos/Plugin/Articulos_plugin.dpk differ
diff --git a/Source/Modulos/Articulos/Plugin/Articulos_plugin.dproj b/Source/Modulos/Articulos/Plugin/Articulos_plugin.dproj
index 088d1bf5..a52a5e2b 100644
--- a/Source/Modulos/Articulos/Plugin/Articulos_plugin.dproj
+++ b/Source/Modulos/Articulos/Plugin/Articulos_plugin.dproj
@@ -89,7 +89,7 @@
-
+
diff --git a/Source/Modulos/Articulos/Servidor/srvArticulos_Impl.dfm b/Source/Modulos/Articulos/Servidor/srvArticulos_Impl.dfm
index 06fb9c47..1ddce252 100644
--- a/Source/Modulos/Articulos/Servidor/srvArticulos_Impl.dfm
+++ b/Source/Modulos/Articulos/Servidor/srvArticulos_Impl.dfm
@@ -1,8 +1,6 @@
object srvArticulos: TsrvArticulos
OldCreateOrder = True
OnCreate = DARemoteServiceCreate
- RequiresSession = True
- SessionManager = dmServer.SessionManager
ConnectionName = 'IBX'
ServiceSchema = schArticulos
ServiceDataStreamer = Bin2DataStreamer
diff --git a/Source/Modulos/Articulos/Servidor/srvArticulos_Impl.pas b/Source/Modulos/Articulos/Servidor/srvArticulos_Impl.pas
index c59e56db..a4d19a39 100644
--- a/Source/Modulos/Articulos/Servidor/srvArticulos_Impl.pas
+++ b/Source/Modulos/Articulos/Servidor/srvArticulos_Impl.pas
@@ -61,7 +61,7 @@ end;
procedure TsrvArticulos.DARemoteServiceCreate(Sender: TObject);
begin
- SessionManager := dmServer.SessionManager;
+ //SessionManager := dmServer.SessionManager;
end;
procedure TsrvArticulos.DataAbstractServiceBeforeAcquireConnection(
diff --git a/Source/Modulos/Articulos/Views/Articulos_view.dproj b/Source/Modulos/Articulos/Views/Articulos_view.dproj
index a2eac61a..ad6b10a4 100644
--- a/Source/Modulos/Articulos/Views/Articulos_view.dproj
+++ b/Source/Modulos/Articulos/Views/Articulos_view.dproj
@@ -54,11 +54,11 @@
MainSource
-
-
-
-
-
+
+
+
+
+
diff --git a/Source/Modulos/Articulos/Views/uEditorArticulos.dfm b/Source/Modulos/Articulos/Views/uEditorArticulos.dfm
index 4d3a0ba5..37357941 100644
--- a/Source/Modulos/Articulos/Views/uEditorArticulos.dfm
+++ b/Source/Modulos/Articulos/Views/uEditorArticulos.dfm
@@ -2,6 +2,7 @@ inherited fEditorArticulos: TfEditorArticulos
Left = 489
Top = 325
Caption = 'Lista de art'#237'culos'
+ ExplicitWidth = 320
ExplicitHeight = 471
PixelsPerInch = 96
TextHeight = 13
@@ -26,9 +27,6 @@ inherited fEditorArticulos: TfEditorArticulos
end
end
inherited TBXDock: TTBXDock
- inherited tbxMain: TTBXToolbar
- ExplicitWidth = 543
- end
inherited tbxFiltro: TTBXToolbar
ExplicitWidth = 269
inherited tbxEditFiltro: TTBXEditItem
diff --git a/Source/Modulos/Articulos/Views/uEditorArticulos.pas b/Source/Modulos/Articulos/Views/uEditorArticulos.pas
index a32aaee4..5db8a8e3 100644
--- a/Source/Modulos/Articulos/Views/uEditorArticulos.pas
+++ b/Source/Modulos/Articulos/Views/uEditorArticulos.pas
@@ -87,7 +87,6 @@ end;
procedure TfEditorArticulos.ImprimirInterno;
begin
-AppFactuGES.ShowCapado;
{
inherited;
}
@@ -116,7 +115,6 @@ end;
procedure TfEditorArticulos.PrevisualizarInterno;
begin
-AppFactuGES.ShowCapado;
{
inherited;
}
@@ -146,7 +144,6 @@ procedure TfEditorArticulos.DuplicarInterno;
{var
AArticulo : IBizArticulo;}
begin
-AppFactuGES.ShowCapado;
{
inherited;
AArticulo := FController.Duplicar(Articulos);
diff --git a/Source/Modulos/Articulos/Views/uEditorElegirArticulos.dfm b/Source/Modulos/Articulos/Views/uEditorElegirArticulos.dfm
index 6d0c6e26..2fc6b872 100644
--- a/Source/Modulos/Articulos/Views/uEditorElegirArticulos.dfm
+++ b/Source/Modulos/Articulos/Views/uEditorElegirArticulos.dfm
@@ -2,41 +2,11 @@ inherited fEditorElegirArticulos: TfEditorElegirArticulos
Caption = 'Seleccionar art'#237'culos'
ClientWidth = 656
ExplicitWidth = 664
- ExplicitHeight = 240
+ ExplicitHeight = 478
PixelsPerInch = 96
TextHeight = 13
- object JvgWizardHeader1: TJvgWizardHeader [0]
- Left = 0
- Top = 27
- Width = 656
- Height = 60
- CaptionFont.Charset = DEFAULT_CHARSET
- CaptionFont.Color = clWindowText
- CaptionFont.Height = -11
- CaptionFont.Name = 'Tahoma'
- CaptionFont.Style = [fsBold]
- CommentFont.Charset = DEFAULT_CHARSET
- CommentFont.Color = clWindowText
- CommentFont.Height = -11
- CommentFont.Name = 'Tahoma'
- CommentFont.Style = []
- SymbolFont.Charset = DEFAULT_CHARSET
- SymbolFont.Color = clHighlightText
- SymbolFont.Height = -35
- SymbolFont.Name = 'Wingdings'
- SymbolFont.Style = [fsBold]
- Captions.Strings = (
- 'Seleccione los art'#237'culos')
- Comments.Strings = (
- ' ')
- Gradient.FromColor = clHighlight
- Gradient.ToColor = clWindow
- Gradient.Active = False
- Gradient.Orientation = fgdVertical
- BufferedDraw = False
- ExplicitTop = 87
- end
inherited JvNavPanelHeader: TJvNavPanelHeader
+ Top = 64
Width = 656
Caption = 'Lista de art'#237'culos'
Visible = False
@@ -47,10 +17,11 @@ inherited fEditorElegirArticulos: TfEditorElegirArticulos
end
end
inherited TBXDock: TTBXDock
- Top = 87
+ Top = 91
Width = 656
- ExplicitTop = 87
+ Height = 49
ExplicitWidth = 656
+ ExplicitHeight = 49
inherited tbxMain: TTBXToolbar
Align = alLeft
DockPos = -6
@@ -86,13 +57,21 @@ inherited fEditorElegirArticulos: TfEditorElegirArticulos
inherited tbxMenu: TTBXToolbar
ExplicitWidth = 656
end
+ inherited TBXTMain2: TTBXToolbar
+ Left = 538
+ Top = 23
+ DockPos = 536
+ DockRow = 1
+ ExplicitLeft = 538
+ ExplicitTop = 23
+ end
end
inherited StatusBar: TJvStatusBar
Width = 656
Visible = False
ExplicitWidth = 656
end
- inline frViewBarraSeleccion1: TfrViewBarraSeleccion [4]
+ inline frViewBarraSeleccion1: TfrViewBarraSeleccion [3]
Left = 0
Top = 376
Width = 656
@@ -132,6 +111,55 @@ inherited fEditorElegirArticulos: TfEditorElegirArticulos
end
end
end
+ object pnlHeader: TPanel [4]
+ Left = 0
+ Top = 0
+ Width = 656
+ Height = 64
+ Align = alTop
+ BevelOuter = bvNone
+ Color = clWhite
+ Padding.Left = 25
+ Padding.Top = 8
+ Padding.Right = 25
+ Padding.Bottom = 8
+ ParentBackground = False
+ TabOrder = 4
+ ExplicitTop = -37
+ object lblTitle: TLabel
+ AlignWithMargins = True
+ Left = 25
+ Top = 8
+ Width = 606
+ Height = 13
+ Margins.Left = 0
+ Margins.Top = 0
+ Margins.Right = 0
+ Margins.Bottom = 8
+ Align = alTop
+ Caption = 'Seleccione los art'#237'culos'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = [fsBold]
+ ParentFont = False
+ ExplicitWidth = 131
+ end
+ object lblComments: TLabel
+ AlignWithMargins = True
+ Left = 50
+ Top = 29
+ Width = 581
+ Height = 27
+ Margins.Left = 25
+ Margins.Top = 0
+ Margins.Right = 0
+ Align = alClient
+ ExplicitLeft = 34
+ ExplicitTop = -6
+ end
+ end
inherited EditorActionList: TActionList [5]
Left = 112
Top = 192
diff --git a/Source/Modulos/Articulos/Views/uEditorElegirArticulos.pas b/Source/Modulos/Articulos/Views/uEditorElegirArticulos.pas
index b23cfa4d..e8b16984 100644
--- a/Source/Modulos/Articulos/Views/uEditorElegirArticulos.pas
+++ b/Source/Modulos/Articulos/Views/uEditorElegirArticulos.pas
@@ -9,18 +9,20 @@ uses
ActnList, uCustomView, uViewBase, uViewGridBase, uViewGrid,
uViewArticulos, ComCtrls, TB2ExtItems, TBXExtItems, TBX,
TB2Item, TB2Dock, TB2Toolbar, pngimage, ExtCtrls, JvExControls, JvComponent,
- JvNavigationPane, uViewBarraSeleccion, JvgWizardHeader, StdCtrls,
+ JvNavigationPane, uViewBarraSeleccion, StdCtrls,
uEditorArticulos, uBizArticulos, uIEditorElegirArticulos,
JvExComCtrls, JvStatusBar, uDAInterfaces;
type
TfEditorElegirArticulos = class(TfEditorArticulos, IEditorElegirArticulos)
frViewBarraSeleccion1: TfrViewBarraSeleccion;
- JvgWizardHeader1: TJvgWizardHeader;
EditorSeleccionActionList: TActionList;
actBuscar2: TAction;
actQuitarFiltro2: TAction;
actAnchoAuto2: TAction;
+ pnlHeader: TPanel;
+ lblTitle: TLabel;
+ lblComments: TLabel;
procedure frViewBarraSeleccion1actSeleccionarUpdate(Sender: TObject);
procedure frViewBarraSeleccion1actCancelarExecute(Sender: TObject);
procedure frViewBarraSeleccion1actSeleccionarExecute(Sender: TObject);
@@ -98,7 +100,7 @@ end;
function TfEditorElegirArticulos.GetMensaje: String;
begin
- Result := JvgWizardHeader1.Comments.Text;
+ Result := lblComments.Caption;
end;
function TfEditorElegirArticulos.GetMultiSelect: Boolean;
@@ -108,7 +110,7 @@ end;
procedure TfEditorElegirArticulos.SetMensaje(const AValue: String);
begin
- JvgWizardHeader1.Comments.Text := AValue;
+ lblComments.Caption := AValue;
end;
procedure TfEditorElegirArticulos.SetMultiSelect(AValue: Boolean);
diff --git a/Source/Modulos/Banca electronica/Views/BancaElectronica_view.bdsproj b/Source/Modulos/Banca electronica/Views/BancaElectronica_view.bdsproj
index 322c0ccd..d4c63c32 100644
--- a/Source/Modulos/Banca electronica/Views/BancaElectronica_view.bdsproj
+++ b/Source/Modulos/Banca electronica/Views/BancaElectronica_view.bdsproj
@@ -172,321 +172,4 @@
-
diff --git a/Source/Modulos/Banca electronica/Views/BancaElectronica_view.dpk b/Source/Modulos/Banca electronica/Views/BancaElectronica_view.dpk
index 1f375ba5..5cbaaba2 100644
Binary files a/Source/Modulos/Banca electronica/Views/BancaElectronica_view.dpk and b/Source/Modulos/Banca electronica/Views/BancaElectronica_view.dpk differ
diff --git a/Source/Modulos/Banca electronica/Views/BancaElectronica_view.dproj b/Source/Modulos/Banca electronica/Views/BancaElectronica_view.dproj
index c213c82d..dba9965b 100644
--- a/Source/Modulos/Banca electronica/Views/BancaElectronica_view.dproj
+++ b/Source/Modulos/Banca electronica/Views/BancaElectronica_view.dproj
@@ -39,542 +39,7 @@
Delphi.Personality
Package
-
- False
- True
- False
-
-
- True
- False
- False
-
-
- True
- False
- 1
- 0
- 0
- 0
- False
- False
- False
- False
- False
- 3082
- 1252
-
-
-
-
- 1.0.0.0
-
-
-
-
-
- 1.0.0.0
-
-
-
- BancaElectronica_view.dpk
-
-
+FalseTrueFalseFalseFalseFalseTrueFalse1000FalseFalseFalseFalseFalse308212521.0.0.01.0.0.0BancaElectronica_view.dpk
-
-
- MainSource
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/Modulos/Banca electronica/Views/BancaElectronica_view.rc b/Source/Modulos/Banca electronica/Views/BancaElectronica_view.rc
index e69de29b..153736af 100644
--- a/Source/Modulos/Banca electronica/Views/BancaElectronica_view.rc
+++ b/Source/Modulos/Banca electronica/Views/BancaElectronica_view.rc
@@ -0,0 +1,22 @@
+1 VERSIONINFO
+FILEVERSION 1,0,0,0
+PRODUCTVERSION 1,0,0,0
+FILEFLAGSMASK 0x3FL
+FILEFLAGS 0x00L
+FILEOS 0x40004L
+FILETYPE 0x1L
+FILESUBTYPE 0x0L
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "0C0A04E4"
+ BEGIN
+ VALUE "FileVersion", "1.0.0.0\0"
+ VALUE "ProductVersion", "1.0.0.0\0"
+ END
+ END
+ BLOCK "VarFileInfo"
+ BEGIN
+ VALUE "Translation", 0x0C0A, 1252
+ END
+END
diff --git a/Source/Modulos/Banca electronica/Views/BancaElectronica_view.res b/Source/Modulos/Banca electronica/Views/BancaElectronica_view.res
index 36f26e23..8b251f31 100644
Binary files a/Source/Modulos/Banca electronica/Views/BancaElectronica_view.res and b/Source/Modulos/Banca electronica/Views/BancaElectronica_view.res differ
diff --git a/Source/Modulos/Banca electronica/Views/uEditorExportacionNorma19.dfm b/Source/Modulos/Banca electronica/Views/uEditorExportacionNorma19.dfm
index 1cd2b439..a4886271 100644
--- a/Source/Modulos/Banca electronica/Views/uEditorExportacionNorma19.dfm
+++ b/Source/Modulos/Banca electronica/Views/uEditorExportacionNorma19.dfm
@@ -1,236 +1,216 @@
-object fEditorExportacionNorma19: TfEditorExportacionNorma19
- Left = 0
- Top = 0
- ActiveControl = edtCodEntidad
- BorderStyle = bsDialog
+inherited fEditorExportacionNorma19: TfEditorExportacionNorma19
Caption = 'Volcado de remesas a disco (Norma 19)'
- ClientHeight = 313
- ClientWidth = 389
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'Tahoma'
- Font.Style = []
- OldCreateOrder = False
- Position = poMainFormCenter
+ ClientHeight = 373
+ ClientWidth = 466
OnCreate = FormCreate
- DesignSize = (
- 389
- 313)
+ ExplicitWidth = 472
+ ExplicitHeight = 405
PixelsPerInch = 96
TextHeight = 13
- object Label2: TLabel
- Left = 24
- Top = 96
- Width = 90
- Height = 13
- Caption = 'Entidad receptora:'
+ inherited Bevel2: TBevel
+ Width = 466
+ ExplicitWidth = 466
end
- object Label3: TLabel
- Left = 24
- Top = 123
- Width = 42
- Height = 13
- Caption = 'Agencia:'
+ inherited Bevel3: TBevel
+ Top = 329
+ Width = 466
+ ExplicitTop = 329
+ ExplicitWidth = 466
end
- object Label4: TLabel
- Left = 24
- Top = 153
- Width = 78
- Height = 13
- Caption = 'Fecha de cargo:'
+ inherited pnlBotones: TPanel
+ Top = 331
+ Width = 466
+ ExplicitTop = 331
+ ExplicitWidth = 466
+ inherited btnAceptar: TButton
+ Left = 280
+ Top = 6
+ Width = 98
+ ExplicitLeft = 280
+ ExplicitTop = 6
+ ExplicitWidth = 98
+ end
+ inherited btnCancelar: TButton
+ Left = 382
+ Top = 6
+ ExplicitLeft = 382
+ ExplicitTop = 6
+ end
end
- object JvgWizardHeader1: TJvgWizardHeader
- Left = 0
- Top = 0
- Width = 389
- Height = 60
- CaptionFont.Charset = DEFAULT_CHARSET
- CaptionFont.Color = clWindowText
- CaptionFont.Height = -11
- CaptionFont.Name = 'Tahoma'
- CaptionFont.Style = [fsBold]
- CommentFont.Charset = DEFAULT_CHARSET
- CommentFont.Color = clWindowText
- CommentFont.Height = -11
- CommentFont.Name = 'Tahoma'
- CommentFont.Style = []
- SymbolFont.Charset = DEFAULT_CHARSET
- SymbolFont.Color = clHighlightText
- SymbolFont.Height = -35
- SymbolFont.Name = 'Wingdings'
- SymbolFont.Style = [fsBold]
- Captions.Strings = (
- 'Volcado de remesas a disco')
- Comments.Strings = (
- 'Introduzca los siguientes datos para realizar el volcado')
- Gradient.FromColor = clHighlight
- Gradient.ToColor = clWindow
- Gradient.Active = False
- Gradient.Orientation = fgdVertical
- BufferedDraw = False
- ExplicitLeft = -8
- ExplicitTop = 76
+ inherited pnlHeader: TPanel
+ Width = 466
+ ExplicitWidth = 466
+ inherited lblTitle: TLabel
+ Width = 416
+ Caption = 'Volcado de remesas a disco - Norma 19'
+ ExplicitWidth = 220
+ end
+ inherited lblComments: TLabel
+ Width = 391
+ Height = 27
+ Visible = False
+ end
+ object Image1: TImage
+ Left = 429
+ Top = 15
+ Width = 28
+ Height = 28
+ AutoSize = True
+ Picture.Data = {
+ 0A54504E474F626A65637489504E470D0A1A0A0000000D494844520000001C00
+ 00001C0806000000720DDF940000000970485973000017120000171201679FD2
+ 520000000467414D410000B18E7CFB5193000002CA4944415478DAADD55F4853
+ 511C07F0DF25C49012DA8B1085A14581E46EAD19A3D05885CA8CA251D04325BD
+ D89342BEF5B087E8CD0C7AA90916E5F0A558C8989935872C866C63EE4F5BB9A8
+ 508CB27AB01552F3EE4F3BBFED1E76B7BBED8E7B7F2078CFBDDCCF39BF73EE77
+ 8CF575280312CA785ACD4879AE5A31043C7FAABDE243CF1D61B87DC70C81D907
+ B2D1AA603A9D86296704548D0D70C3745780AAAFD833A189BE9A265111241897
+ 4CC3B4EB1DE8D816887D5EA32862E12F00C1EBCA80630C03FD090E382E05AF16
+ 62D8523A91260318BB59308DD89501138718A81FBE07639787E0E2AF8DEC2A53
+ F0F4851BEF8D3B5288C5FFFC8551F35CAEB5EDBB406A6B4B401E4B8C0EE1F5E3
+ 2040DFDA3AB6F6DCCD058A91499031D201DFDB1590DA5E01588CF14550FDF20F
+ B860F2E27557C75E8AE5E014FEFFCCB65815A520D9B3014B295688721333D852
+ 52DA83CD303EE9A6F7CFF6AA21B199849773D18A2882674EB4E10C2D0DF5D0CF
+ 8A631DD15570FB23F068D286878694A08DAC39A3EFDC8FE8269704DFC35EA62C
+ D873EC00DD13AB6A9B00E53172DF1B7A8F60D9CF228B6A35CDE0F3AF945D2582
+ 278FEECBED497E3F6676AA102DC4C85F20FA8182783A8B3EFC9EE137996F3FE3
+ 150F10829D9A56FAD2647EA5F32D4D028C8C45621F05A0580EDFB2AC22681DD1
+ D1B1C21C4650A7DE23C004A72F3F464A0C2CFE86D9ABD308660203785D9CC308
+ 1E69DB0D368707A4542DA0580E2358185B52AA1A187C62289BC3B27E6E447338
+ BE08E9ED2CDD9AE21C5616CC62B034082EA71B0E0FFEA36780CF61B21DCA829E
+ E3008DB997C7B2B9BEE3D26F7AE8EC4EAFC2607E753CE89A0268BDB64EBFEF59
+ 975F3990BCB0CEDF4531BEC82AC1F01DF772DE13520624395CB71112AC8E2FB2
+ 4A95F12B4E88CF61D920C9E186B0BE042B44B71A96690ECB6FA93609AEFB9A8A
+ CF6DE9FE447358362896C362D1C8C7A26CB0D61C960DD69AC3B2C15A73F83F42
+ 0A9D9B19DC72610000000049454E44AE426082}
+ end
end
- object Image1: TImage
- Left = 345
- Top = 15
- Width = 28
- Height = 28
- AutoSize = True
- Picture.Data = {
- 0A54504E474F626A65637489504E470D0A1A0A0000000D494844520000001C00
- 00001C0806000000720DDF940000000970485973000017120000171201679FD2
- 520000000467414D410000B18E7CFB5193000002CA4944415478DAADD55F4853
- 511C07F0DF25C49012DA8B1085A14581E46EAD19A3D05885CA8CA251D04325BD
- D89342BEF5B087E8CD0C7AA90916E5F0A558C8989935872C866C63EE4F5BB9A8
- 508CB27AB01552F3EE4F3BBFED1E76B7BBED8E7B7F2078CFBDDCCF39BF73EE77
- 8CF575280312CA785ACD4879AE5A31043C7FAABDE243CF1D61B87DC70C81D907
- B2D1AA603A9D86296704548D0D70C3745780AAAFD833A189BE9A265111241897
- 4CC3B4EB1DE8D816887D5EA32862E12F00C1EBCA80630C03FD090E382E05AF16
- 62D8523A91260318BB59308DD89501138718A81FBE07639787E0E2AF8DEC2A53
- F0F4851BEF8D3B5288C5FFFC8551F35CAEB5EDBB406A6B4B401E4B8C0EE1F5E3
- 2040DFDA3AB6F6DCCD058A91499031D201DFDB1590DA5E01588CF14550FDF20F
- B860F2E27557C75E8AE5E014FEFFCCB65815A520D9B3014B295688721333D852
- 52DA83CD303EE9A6F7CFF6AA21B199849773D18A2882674EB4E10C2D0DF5D0CF
- 8A631DD15570FB23F068D286878694A08DAC39A3EFDC8FE8269704DFC35EA62C
- D873EC00DD13AB6A9B00E53172DF1B7A8F60D9CF228B6A35CDE0F3AF945D2582
- 278FEECBED497E3F6676AA102DC4C85F20FA8182783A8B3EFC9EE137996F3FE3
- 150F10829D9A56FAD2647EA5F32D4D028C8C45621F05A0580EDFB2AC22681DD1
- D1B1C21C4650A7DE23C004A72F3F464A0C2CFE86D9ABD308660203785D9CC308
- 1E69DB0D368707A4542DA0580E2358185B52AA1A187C62289BC3B27E6E447338
- BE08E9ED2CDD9AE21C5616CC62B034082EA71B0E0FFEA36780CF61B21DCA829E
- E3008DB997C7B2B9BEE3D26F7AE8EC4EAFC2607E753CE89A0268BDB64EBFEF59
- 975F3990BCB0CEDF4531BEC82AC1F01DF772DE13520624395CB71112AC8E2FB2
- 4A95F12B4E88CF61D920C9E186B0BE042B44B71A96690ECB6FA93609AEFB9A8A
- CF6DE9FE447358362896C362D1C8C7A26CB0D61C960DD69AC3B2C15A73F83F42
- 0A9D9B19DC72610000000049454E44AE426082}
+ inherited pnlCuerpo: TPanel
+ Width = 466
+ Height = 263
+ ExplicitWidth = 466
+ ExplicitHeight = 263
+ object Bevel12: TBevel
+ Left = 50
+ Top = 132
+ Width = 349
+ Height = 5
+ Shape = bsBottomLine
+ end
+ object Label1: TLabel
+ Left = 50
+ Top = 152
+ Width = 71
+ Height = 13
+ Caption = 'Guardar como:'
+ end
+ object Label2: TLabel
+ Left = 50
+ Top = 40
+ Width = 90
+ Height = 13
+ Caption = 'Entidad receptora:'
+ end
+ object Label3: TLabel
+ Left = 50
+ Top = 67
+ Width = 42
+ Height = 13
+ Caption = 'Agencia:'
+ end
+ object Label4: TLabel
+ Left = 50
+ Top = 97
+ Width = 78
+ Height = 13
+ Caption = 'Fecha de cargo:'
+ end
+ object Label5: TLabel
+ Left = 228
+ Top = 40
+ Width = 48
+ Height = 13
+ Caption = '(4 d'#237'gitos)'
+ end
+ object Label6: TLabel
+ Left = 228
+ Top = 67
+ Width = 48
+ Height = 13
+ Caption = '(4 d'#237'gitos)'
+ end
+ object edtCodAgencia: TcxMaskEdit
+ Left = 146
+ Top = 64
+ Properties.BeepOnError = True
+ Properties.MaxLength = 4
+ 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 = 0
+ Text = ' '
+ Width = 73
+ end
+ object edtCodEntidad: TcxMaskEdit
+ Left = 146
+ Top = 37
+ Properties.BeepOnError = True
+ Properties.MaxLength = 4
+ 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 = 1
+ Text = ' '
+ Width = 73
+ end
+ object edtFechaCargo: TcxDateEdit
+ Left = 146
+ Top = 94
+ Properties.DateButtons = [btnToday]
+ Properties.ImmediatePost = True
+ Properties.SaveTime = False
+ Properties.ShowTime = 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 = 2
+ Width = 167
+ end
+ object JvFilenameEdit1: TJvFilenameEdit
+ Left = 50
+ Top = 170
+ Width = 349
+ Height = 21
+ Flat = False
+ ParentFlat = False
+ Filter = 'Ficheros de norma 19 (*.C19)|*.C19'
+ DialogOptions = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist]
+ DialogTitle = 'Volcar a disco la remesa'
+ TabOrder = 3
+ end
end
- object Bevel1: TBevel
- Left = 8
- Top = 268
- Width = 373
- Height = 3
- Anchors = [akLeft, akRight, akBottom]
- Shape = bsBottomLine
- ExplicitTop = 328
- end
- object Label1: TLabel
- Left = 24
- Top = 208
- Width = 71
- Height = 13
- Caption = 'Guardar como:'
- end
- object Bevel2: TBevel
- Left = 24
- Top = 188
- Width = 349
- Height = 3
- Anchors = [akLeft, akTop, akRight]
- Shape = bsBottomLine
- end
- object Label5: TLabel
- Left = 202
- Top = 96
- Width = 48
- Height = 13
- Caption = '(4 d'#237'gitos)'
- end
- object Label6: TLabel
- Left = 202
- Top = 123
- Width = 48
- Height = 13
- Caption = '(4 d'#237'gitos)'
- end
- object edtFechaCargo: TcxDateEdit
- Left = 120
- Top = 150
- Properties.DateButtons = [btnToday]
- Properties.ImmediatePost = True
- Properties.SaveTime = False
- Properties.ShowTime = 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 = 2
- Width = 167
- end
- object edtCodEntidad: TcxMaskEdit
- Left = 120
- Top = 93
- Properties.BeepOnError = True
- Properties.MaxLength = 4
- 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 = 0
- Text = ' '
- Width = 73
- end
- object edtCodAgencia: TcxMaskEdit
- Left = 120
- Top = 120
- Properties.BeepOnError = True
- Properties.MaxLength = 4
- 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 = 1
- Text = ' '
- Width = 73
- end
- object CancelBtn: TButton
- Left = 301
- Top = 277
- Width = 75
- Height = 25
- Anchors = [akLeft, akRight, akBottom]
- Cancel = True
- Caption = '&Cancelar'
- ModalResult = 2
- TabOrder = 4
- OnClick = CancelBtnClick
- ExplicitTop = 265
- end
- object OKBtn: TButton
- Left = 202
- Top = 277
- Width = 85
- Height = 25
- Action = actVolcar
- Anchors = [akLeft, akRight, akBottom]
- TabOrder = 3
- ExplicitTop = 265
- end
- object JvFilenameEdit1: TJvFilenameEdit
- Left = 24
- Top = 227
- Width = 349
- Height = 21
- Flat = False
- ParentCtl3D = False
- Filter = 'Ficheros de norma 19 (*.C19)|*.C19'
- DialogOptions = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist]
- DialogTitle = 'Volcar a disco la remesa'
- TabOrder = 5
+ inherited ActionListDialog: TActionList
+ Top = 64
+ inherited actAceptar: TAction
+ Caption = '&Volcar a disco'
+ OnExecute = actAceptarExecute
+ OnUpdate = actAceptarUpdate
+ end
end
object JvFormStorage: TJvFormStorage
AppStorage = JvAppRegistryStorage
@@ -251,13 +231,4 @@ object fEditorExportacionNorma19: TfEditorExportacionNorma19
Left = 112
Top = 64
end
- object ActionList1: TActionList
- Left = 272
- Top = 72
- object actVolcar: TAction
- Caption = 'Volcar a disco'
- OnExecute = actVolcarExecute
- OnUpdate = actVolcarUpdate
- end
- end
end
diff --git a/Source/Modulos/Banca electronica/Views/uEditorExportacionNorma19.pas b/Source/Modulos/Banca electronica/Views/uEditorExportacionNorma19.pas
index bd720887..d2202f67 100644
--- a/Source/Modulos/Banca electronica/Views/uEditorExportacionNorma19.pas
+++ b/Source/Modulos/Banca electronica/Views/uEditorExportacionNorma19.pas
@@ -5,15 +5,13 @@ interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, pngimage, cxControls, cxContainer, cxEdit,
- cxTextEdit, cxMaskEdit, cxDropDownEdit, cxCalendar,
- uIEditorExportacionNorma19, JvExControls, JvComponent, JvgWizardHeader,
+ cxTextEdit, cxMaskEdit, cxDropDownEdit, cxCalendar, uDialogBase,
+ uIEditorExportacionNorma19, JvExControls, JvComponent,
JvAppStorage, JvAppRegistryStorage, JvComponentBase, JvFormPlacement,
JvDialogs, Mask, JvExMask, JvToolEdit, ActnList;
type
- TfEditorExportacionNorma19 = class(TForm, IEditorExportacionNorma19)
- OKBtn: TButton;
- CancelBtn: TButton;
+ TfEditorExportacionNorma19 = class(TfDialogBase, IEditorExportacionNorma19)
Image1: TImage;
edtFechaCargo: TcxDateEdit;
Label2: TLabel;
@@ -21,22 +19,18 @@ type
Label4: TLabel;
edtCodEntidad: TcxMaskEdit;
edtCodAgencia: TcxMaskEdit;
- JvgWizardHeader1: TJvgWizardHeader;
- Bevel1: TBevel;
JvFormStorage: TJvFormStorage;
JvAppRegistryStorage: TJvAppRegistryStorage;
Label1: TLabel;
- Bevel2: TBevel;
+ Bevel12: TBevel;
JvFilenameEdit1: TJvFilenameEdit;
- ActionList1: TActionList;
- actVolcar: TAction;
Label5: TLabel;
Label6: TLabel;
procedure OKBtnClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CancelBtnClick(Sender: TObject);
- procedure actVolcarUpdate(Sender: TObject);
- procedure actVolcarExecute(Sender: TObject);
+ procedure actAceptarExecute(Sender: TObject);
+ procedure actAceptarUpdate(Sender: TObject);
private
FFichero : String;
protected
@@ -68,14 +62,16 @@ uses
{ TfEditorExportacionNorma19 }
-procedure TfEditorExportacionNorma19.actVolcarExecute(Sender: TObject);
+procedure TfEditorExportacionNorma19.actAceptarExecute(Sender: TObject);
begin
+ inherited;
FFichero := JvFilenameEdit1.FileName;
ModalResult := mrOk;
end;
-procedure TfEditorExportacionNorma19.actVolcarUpdate(Sender: TObject);
+procedure TfEditorExportacionNorma19.actAceptarUpdate(Sender: TObject);
begin
+ inherited;
(Sender as TAction).Enabled :=
(Length(edtCodEntidad.Text) = 4) and
(Length(edtCodAgencia.Text) = 4) and
@@ -125,7 +121,6 @@ end;
procedure TfEditorExportacionNorma19.OKBtnClick(Sender: TObject);
var
- ASaveDialog : TSaveDialog; // Save dialog variable
AArchivo : string;
ARuta : String;
begin
diff --git a/Source/Modulos/Comisiones/Servidor/srvComisiones_Impl.dfm b/Source/Modulos/Comisiones/Servidor/srvComisiones_Impl.dfm
index fd8c7d8f..3264da27 100644
--- a/Source/Modulos/Comisiones/Servidor/srvComisiones_Impl.dfm
+++ b/Source/Modulos/Comisiones/Servidor/srvComisiones_Impl.dfm
@@ -1,8 +1,6 @@
object srvComisiones: TsrvComisiones
OldCreateOrder = True
OnCreate = DARemoteServiceCreate
- RequiresSession = True
- SessionManager = dmServer.SessionManager
ConnectionName = 'IBX'
ServiceSchema = schComisiones
ServiceDataStreamer = Bin2DataStreamer
diff --git a/Source/Modulos/Comisiones/Servidor/srvComisiones_Impl.pas b/Source/Modulos/Comisiones/Servidor/srvComisiones_Impl.pas
index 8804d475..b0b09a1b 100644
--- a/Source/Modulos/Comisiones/Servidor/srvComisiones_Impl.pas
+++ b/Source/Modulos/Comisiones/Servidor/srvComisiones_Impl.pas
@@ -52,7 +52,7 @@ end;
{ srvComisiones }
procedure TsrvComisiones.DARemoteServiceCreate(Sender: TObject);
begin
- SessionManager := dmServer.SessionManager;
+ //SessionManager := dmServer.SessionManager;
bpComisiones.BusinessRulesID := BIZ_SERVER_COMISIONES;
end;
diff --git a/Source/Modulos/Comisiones/Views/Comisiones_view.dpk b/Source/Modulos/Comisiones/Views/Comisiones_view.dpk
index 299934c8..04437ecf 100644
--- a/Source/Modulos/Comisiones/Views/Comisiones_view.dpk
+++ b/Source/Modulos/Comisiones/Views/Comisiones_view.dpk
@@ -25,56 +25,13 @@ package Comisiones_view;
{$IMPLICITBUILD OFF}
requires
- Comisiones_controller,
- Comisiones_model,
+ Base,
GUIBase,
ApplicationBase,
Contactos_model,
Contactos_controller,
- teeUI,
- tee,
- fsTee11,
- frxTee11,
- vcl,
- rtl,
- dbrtl,
- vcldb,
- DataAbstract_Core_D11,
- dsnap,
- adortl,
- RemObjects_Core_D11,
- PngComponentsD10,
- PNG_D10,
- vclactnband,
- vclx,
- GUISDK_D11,
- xmlrtl,
- cfpack_d11,
- designide,
- ccpackD11,
- cxLibraryD11,
- dxThemeD11,
- dxGDIPlusD11,
- cxEditorsD11,
- cxDataD11,
- vcljpg,
- cxGridD11,
- cxPageControlD11,
- cxExtEditorsD11,
- cxExportD11,
- dxLayoutControlD11,
- dxComnD11,
- tb2k_d10,
- tbx_d10,
- JvCoreD11R,
- Jcl,
- JclVcl,
- JvSystemD11R,
- JvStdCtrlsD11R,
- JvPageCompsD11R,
- frx11,
- fs11,
- frxe11;
+ Comisiones_controller,
+ Comisiones_model;
contains
uComisionesViewRegister in 'uComisionesViewRegister.pas',
diff --git a/Source/Modulos/Comisiones/Views/Comisiones_view.dproj b/Source/Modulos/Comisiones/Views/Comisiones_view.dproj
index f74409e7..2641ae41 100644
--- a/Source/Modulos/Comisiones/Views/Comisiones_view.dproj
+++ b/Source/Modulos/Comisiones/Views/Comisiones_view.dproj
@@ -49,10 +49,12 @@
+
+
@@ -90,7 +92,6 @@
-
@@ -99,32 +100,32 @@
-
TfEditorComision
+
-
TfEditorComisiones
+
-
TfEditorComision
+
-
TFrame
+
-
TFrame
+
-
TFrame
+
-
TFrame
+
diff --git a/Source/Modulos/Contabilidad/Controller/Contabilidad_controller.dpk b/Source/Modulos/Contabilidad/Controller/Contabilidad_controller.dpk
index 3cc8593a..4fb2af01 100644
Binary files a/Source/Modulos/Contabilidad/Controller/Contabilidad_controller.dpk and b/Source/Modulos/Contabilidad/Controller/Contabilidad_controller.dpk differ
diff --git a/Source/Modulos/Contabilidad/Plugin/Contabilidad_plugin.dpk b/Source/Modulos/Contabilidad/Plugin/Contabilidad_plugin.dpk
index 8480d9cf..b9f28a57 100644
Binary files a/Source/Modulos/Contabilidad/Plugin/Contabilidad_plugin.dpk and b/Source/Modulos/Contabilidad/Plugin/Contabilidad_plugin.dpk differ
diff --git a/Source/Modulos/Contabilidad/Plugin/Contabilidad_plugin.dproj b/Source/Modulos/Contabilidad/Plugin/Contabilidad_plugin.dproj
index 81f5b52f..e4be2023 100644
--- a/Source/Modulos/Contabilidad/Plugin/Contabilidad_plugin.dproj
+++ b/Source/Modulos/Contabilidad/Plugin/Contabilidad_plugin.dproj
@@ -54,7 +54,7 @@
-
+
diff --git a/Source/Modulos/Contabilidad/Servidor/srvContabilidad_Impl.pas b/Source/Modulos/Contabilidad/Servidor/srvContabilidad_Impl.pas
index 893f5685..b9df3d82 100644
--- a/Source/Modulos/Contabilidad/Servidor/srvContabilidad_Impl.pas
+++ b/Source/Modulos/Contabilidad/Servidor/srvContabilidad_Impl.pas
@@ -243,7 +243,7 @@ end;
procedure TsrvContabilidad.DARemoteServiceCreate(Sender: TObject);
begin
- SessionManager := dmServer.SessionManager;
+ //SessionManager := dmServer.SessionManager;
bpAsientos.BusinessRulesID := BIZ_SERVER_ASIENTOS;
end;
diff --git a/Source/Modulos/Contabilidad/Views/Contabilidad_view.dpk b/Source/Modulos/Contabilidad/Views/Contabilidad_view.dpk
index 54d09f84..a00dd8c4 100644
--- a/Source/Modulos/Contabilidad/Views/Contabilidad_view.dpk
+++ b/Source/Modulos/Contabilidad/Views/Contabilidad_view.dpk
@@ -26,56 +26,11 @@ package Contabilidad_view;
{$DEFINE DEBUG}
requires
+ Base,
GUIBase,
ApplicationBase,
Contabilidad_model,
- Contabilidad_controller,
- vcl,
- rtl,
- dbrtl,
- DataAbstract_Core_D11,
- vcldb,
- dsnap,
- adortl,
- RemObjects_Core_D11,
- cxLibraryD11,
- dxThemeD11,
- dxGDIPlusD11,
- cxEditorsD11,
- cxDataD11,
- vcljpg,
- dxLayoutControlD11,
- dxComnD11,
- PngComponentsD10,
- PNG_D10,
- vclactnband,
- vclx,
- tb2k_d10,
- tbx_d10,
- JvCoreD11R,
- Jcl,
- JclVcl,
- JvAppFrmD11R,
- JvCtrlsD11R,
- JvSystemD11R,
- JvStdCtrlsD11R,
- cxGridD11,
- cxPageControlD11,
- cxExtEditorsD11,
- cxExportD11,
- dxPSCoreD11,
- cxIntlPrintSys3D11,
- designide,
- xmlrtl,
- dxPScxCommonD11,
- dxPSLnksD11,
- vclshlctrls,
- dxPScxGrid6LnkD11,
- dclcxLibraryD11,
- JvPageCompsD11R,
- GUISDK_D11,
- cfpack_d11,
- ccpackD11;
+ Contabilidad_controller;
contains
uEditorBalance in 'uEditorBalance.pas' {fEditorBalance: TfEditorBalances},
diff --git a/Source/Modulos/Contabilidad/Views/Contabilidad_view.dproj b/Source/Modulos/Contabilidad/Views/Contabilidad_view.dproj
index 7b471b76..0a6e86ee 100644
--- a/Source/Modulos/Contabilidad/Views/Contabilidad_view.dproj
+++ b/Source/Modulos/Contabilidad/Views/Contabilidad_view.dproj
@@ -48,49 +48,11 @@
MainSource
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
TFrame
@@ -161,7 +123,7 @@
- TfEditorEjercicios
+ TfEditorExtractoMovimientos
@@ -223,13 +185,6 @@
TFrame
-
-
-
-
-
-
-