From b55dd9382cae0888544ea47fa54f0e1d621d1fc1 Mon Sep 17 00:00:00 2001 From: david Date: Tue, 14 Apr 2009 16:38:32 +0000 Subject: [PATCH] =?UTF-8?q?Repaso=20general.=20Adaptaci=C3=B3n=20de=20libr?= =?UTF-8?q?er=C3=ADas.=20Eliminado=20el=20uso=20del=20componente=20JvgWiza?= =?UTF-8?q?rdHeader.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit git-svn-id: https://192.168.0.254/svn/Proyectos.Acana_FactuGES2/trunk@413 f4e31baf-9722-1c47-927c-6f952f962d4b --- Build/Build.fbp5 | 224 +- Database/scripts/factuges.sql | 58 +- Database/scripts/factuges_replicador.sql | 134 +- Installer/librerias.txt | 8 +- Source/ApplicationBase/ApplicationBase.dpk | 2 +- Source/ApplicationBase/ApplicationBase.dproj | 49 +- .../Controller/uEjerciciosController.pas | 3 +- .../Ejercicios/Plugin/Ejercicios_plugin.dpk | Bin 707 -> 707 bytes .../Ejercicios/Plugin/Ejercicios_plugin.dproj | 2 +- .../Servidor/srvEjercicios_Impl.pas | 2 +- .../Views/uEditorElegirEjercicios.dfm | 123 +- .../Views/uEditorElegirEjercicios.pas | 10 +- .../Controller/uEmpresasController.pas | 2 - .../Empresas/Servidor/srvEmpresas_Impl.dfm | 1 - .../Empresas/Servidor/srvEmpresas_Impl.pas | 2 +- .../Usuarios/Servidor/srvUsuarios_Impl.pas | 8 +- Source/ApplicationBase/uFactuGES_App.pas | 81 +- Source/Base/Base.dpk | 6 +- Source/Base/Base.dproj | 98 +- Source/Base/Base.res | Bin 4748 -> 384 bytes Source/Cliente/FactuGES.dproj | 5 +- Source/Cliente/VCLFixPack.pas | 2830 +++++++++++++++++ Source/Cliente/uBootStrap.pas | 6 + Source/Cliente/uPantallaPrincipal.dfm | 1 + Source/Cliente/uPantallaPrincipal.pas | 14 +- Source/GUIBase/GUIBase.dpk | Bin 2632 -> 2673 bytes Source/GUIBase/GUIBase.dproj | 68 +- Source/GUIBase/uDialogBase.dfm | 144 +- Source/GUIBase/uDialogBase.pas | 50 +- Source/GUIBase/uDialogElegirEMail.dfm | 102 +- Source/GUIBase/uEditorDBBase.pas | 5 +- Source/GUIBase/uEditorDBItem.pas | 5 +- Source/GUIBase/uViewGridBase.pas | 4 +- .../Servidor/srvAlbaranesCliente_Impl.dfm | 2 - .../Servidor/srvAlbaranesCliente_Impl.pas | 2 +- .../Views/uEditorAlbaranesCliente.dfm | 1 + .../Views/uEditorAlbaranesCliente.pas | 3 - .../Views/uEditorElegirAlbaranesCliente.dfm | 101 +- .../Views/uEditorElegirAlbaranesCliente.pas | 12 +- .../uEditorElegirArticulosAlbaranCliente.dfm | 10 +- .../uEditorElegirArticulosAlbaranCliente.pas | 3 +- .../Servidor/srvAlbaranesProveedor_Impl.dfm | 2 - .../Servidor/srvAlbaranesProveedor_Impl.pas | 2 +- .../Views/uEditorAlbaranProveedor.pas | 2 - .../Views/uEditorAlbaranesProveedor.pas | 12 +- .../Views/uEditorElegirAlbaranesProveedor.dfm | 112 +- .../Views/uEditorElegirAlbaranesProveedor.pas | 12 +- ...uEditorElegirArticulosAlbaranProveedor.pas | 2 +- .../Almacenes/Servidor/srvAlmacenes_Impl.dfm | 2 - .../Almacenes/Servidor/srvAlmacenes_Impl.pas | 2 +- .../Almacenes/Views/uEditorAlmacenes.pas | 5 +- .../Articulos/Plugin/Articulos_plugin.dpk | Bin 616 -> 616 bytes .../Articulos/Plugin/Articulos_plugin.dproj | 2 +- .../Articulos/Servidor/srvArticulos_Impl.dfm | 2 - .../Articulos/Servidor/srvArticulos_Impl.pas | 2 +- .../Articulos/Views/Articulos_view.dproj | 10 +- .../Articulos/Views/uEditorArticulos.dfm | 4 +- .../Articulos/Views/uEditorArticulos.pas | 3 - .../Views/uEditorElegirArticulos.dfm | 98 +- .../Views/uEditorElegirArticulos.pas | 10 +- .../Views/BancaElectronica_view.bdsproj | 317 -- .../Views/BancaElectronica_view.dpk | Bin 726 -> 719 bytes .../Views/BancaElectronica_view.dproj | 537 +--- .../Views/BancaElectronica_view.rc | 22 + .../Views/BancaElectronica_view.res | Bin 32 -> 384 bytes .../Views/uEditorExportacionNorma19.dfm | 437 ++- .../Views/uEditorExportacionNorma19.pas | 25 +- .../Servidor/srvComisiones_Impl.dfm | 2 - .../Servidor/srvComisiones_Impl.pas | 2 +- .../Comisiones/Views/Comisiones_view.dpk | 49 +- .../Comisiones/Views/Comisiones_view.dproj | 17 +- .../Controller/Contabilidad_controller.dpk | Bin 2374 -> 2141 bytes .../Plugin/Contabilidad_plugin.dpk | Bin 786 -> 786 bytes .../Plugin/Contabilidad_plugin.dproj | 2 +- .../Servidor/srvContabilidad_Impl.pas | 2 +- .../Contabilidad/Views/Contabilidad_view.dpk | 49 +- .../Views/Contabilidad_view.dproj | 57 +- .../Contabilidad/Views/uEditorBalances.dfm | 6 +- .../Contabilidad/Views/uEditorBalances.pas | 3 - .../Contabilidad/Views/uEditorCuentas.dfm | 12 - .../Contabilidad/Views/uEditorCuentas.pas | 1 - .../Views/uEditorCuentasEspeciales.dfm | 3 - .../Views/uEditorCuentasEspeciales.pas | 1 - .../Contabilidad/Views/uEditorDiario.dfm | 18 +- .../Contabilidad/Views/uEditorDiario.pas | 1 - .../Views/uEditorElegirBalances.dfm | 148 +- .../Views/uEditorElegirBalances.pas | 12 +- .../Views/uEditorElegirCuentas.dfm | 116 +- .../Views/uEditorElegirCuentas.pas | 10 +- .../Views/uEditorElegirCuentasEspeciales.dfm | 135 +- .../Views/uEditorElegirCuentasEspeciales.pas | 12 +- .../Views/uEditorElegirEpigrafes.dfm | 138 +- .../Views/uEditorElegirEpigrafes.pas | 10 +- .../Views/uEditorElegirSubCuentas.dfm | 142 +- .../Views/uEditorElegirSubCuentas.pas | 10 +- .../Contabilidad/Views/uEditorEpigrafe.dfm | 46 +- .../Contabilidad/Views/uEditorEpigrafes.dfm | 18 +- .../Contabilidad/Views/uEditorEpigrafes.pas | 1 - .../Views/uViewExtractoMovimientos.dfm | 12 - .../Views/uViewExtractoMovimientos.pas | 2 - .../Controller/Contactos_controller.dpk | Bin 2726 -> 2476 bytes .../Controller/Contactos_controller.dproj | 48 +- .../View/uIEditorElegirPersonaContacto.pas | 8 +- .../Controller/uContactosController.pas | 2 +- .../Controller/uGruposClienteController.pas | 2 - .../Controller/uGruposProveedorController.pas | 2 - .../uProcedenciasClienteController.pas | 2 - .../Contactos/Model/uBizClientesServer.pas | 1 - .../Contactos/Model/uBizProveedoresServer.pas | 1 - .../Contactos/Plugin/Contactos_plugin.dpk | Bin 711 -> 711 bytes .../Contactos/Plugin/Contactos_plugin.dproj | 2 +- .../Contactos/Servidor/srvContactos_Impl.pas | 2 +- .../Contactos/Views/Contactos_view.dpk | 5 +- .../Contactos/Views/Contactos_view.dproj | 54 +- .../Contactos/Views/uEditorElegirClientes.dfm | 124 +- .../Contactos/Views/uEditorElegirClientes.pas | 10 +- .../Views/uEditorElegirPersonaContacto.dfm | 440 ++- .../Views/uEditorElegirPersonaContacto.pas | 52 +- .../Views/uEditorElegirProveedores.dfm | 116 +- .../Views/uEditorElegirProveedores.pas | 15 +- .../Views/uEditorElegirVendedores.dfm | 105 +- .../Views/uEditorElegirVendedores.pas | 15 +- .../Servidor/srvFacturasCliente_Impl.dfm | 2 - .../Servidor/srvFacturasCliente_Impl.pas | 2 +- .../uEditorElegirArticulosFacturaCliente.dfm | 10 +- .../uEditorElegirArticulosFacturaCliente.pas | 3 +- .../Views/uEditorElegirFacturasCliente.dfm | 188 +- .../Views/uEditorElegirFacturasCliente.pas | 13 +- .../Views/uEditorFacturaCliente.pas | 2 +- .../uViewElegirArticulosFacturasCliente.dfm | 2 +- .../uViewElegirArticulosFacturasCliente.pas | Bin 1052 -> 1069 bytes .../Servidor/srvFacturasProveedor_Impl.dfm | 2 - .../Servidor/srvFacturasProveedor_Impl.pas | 2 +- ...uEditorElegirArticulosFacturaProveedor.pas | 2 +- .../Views/uEditorFacturaProveedor.dfm | 156 +- .../Views/uEditorFacturaProveedor.pas | 2 - .../Familias/Plugin/Familias_plugin.dpk | Bin 687 -> 687 bytes .../Familias/Plugin/Familias_plugin.dproj | 2 +- .../Familias/Servidor/srvFamilias_Impl.pas | 2 +- .../Plugin/FormasPago_plugin.dpk | Bin 716 -> 716 bytes .../Plugin/FormasPago_plugin.dproj | 2 +- .../Servidor/srvFormasPago_Impl.pas | 2 +- .../Servidor/srvGestorDocumentos_Impl.pas | 3 +- .../Servidor/srvGestorInformes_Impl.dfm | 4 - .../Servidor/srvGestorInformes_Impl.pas | 6 +- .../Views/GestorInformes_view.dpk | 35 +- .../Views/GestorInformes_view.dproj | 47 +- .../Views/uEditorElegirArticulosAlmacen.dfm | 170 +- .../Views/uEditorElegirArticulosAlmacen.pas | 12 +- .../Views/uEditorElegirArticulosCatalogo.dfm | 9 + .../Views/uEditorElegirArticulosCatalogo.pas | 2 +- .../Inventario/Views/uEditorInventario.dfm | 2 +- .../Inventario/Views/uEditorInventario.pas | 3 +- .../Servidor/srvPedidosProveedor_Impl.dfm | 2 - .../Servidor/srvPedidosProveedor_Impl.pas | 2 +- .../uEditorElegirArticulosPedidoProveedor.dfm | 9 + .../uEditorElegirArticulosPedidoProveedor.pas | 4 +- .../Views/uEditorElegirPedidosProveedor.dfm | 133 +- .../Views/uEditorElegirPedidosProveedor.pas | 10 +- .../Views/uEditorPedidoProveedor.pas | 2 - .../Views/uEditorPedidosProveedor.pas | 17 +- .../Views/uEditorSituacionPedidoProveedor.dfm | 346 +- .../Views/uEditorSituacionPedidoProveedor.pas | 13 +- .../Plugin/PresupuestosCliente_plugin.dpk | Bin 694 -> 694 bytes .../Plugin/PresupuestosCliente_plugin.dproj | 2 +- .../Servidor/srvPresupuestosCliente_Impl.dfm | 2 - .../Servidor/srvPresupuestosCliente_Impl.pas | 2 +- ...ditorElegirArticulosPresupuestoCliente.pas | 2 +- .../uEditorElegirPresupuestosCliente.dfm | 97 +- .../uEditorElegirPresupuestosCliente.pas | 10 +- .../Views/uEditorPresupuestoCliente.pas | 2 - .../Views/uEditorPresupuestosCliente.pas | 20 +- .../Servidor/srvRecibosCliente_Impl.dfm | 2 - .../Servidor/srvRecibosCliente_Impl.pas | 2 +- .../Views/uEditorElegirRecibosCliente.dfm | Bin 8326 -> 13523 bytes .../Views/uEditorElegirRecibosCliente.pas | 11 +- .../Servidor/srvRecibosProveedor_Impl.pas | 2 +- .../Views/uEditorElegirRecibosProveedor.dfm | 136 +- .../Views/uEditorElegirRecibosProveedor.pas | 11 +- .../Views/uEditorReciboProveedor.pas | 2 - .../Servidor/srvReferencias_Impl.pas | 2 +- .../Servidor/srvRemesasCliente_Impl.dfm | 2 - .../Servidor/srvRemesasCliente_Impl.pas | 2 +- .../Servidor/srvRemesasProveedor_Impl.dfm | 2 - .../Servidor/srvRemesasProveedor_Impl.pas | 2 +- .../Tipos de IVA/Plugin/TiposIVA_plugin.dpk | Bin 687 -> 687 bytes .../Tipos de IVA/Plugin/TiposIVA_plugin.dproj | 2 +- .../Servidor/srvTiposIVA_Impl.dfm | 2 - .../Servidor/srvTiposIVA_Impl.pas | 2 +- .../Servidor/srvTiposVenta_Impl.pas | 2 +- .../Plugin/UnidadesMedida_plugin.dpk | Bin 723 -> 723 bytes .../Plugin/UnidadesMedida_plugin.dproj | 2 +- .../Servidor/srvUnidadesMedida_Impl.dfm | 2 - .../Servidor/srvUnidadesMedida_Impl.pas | 2 +- Source/Servicios/FactuGES.RODL | 58 +- Source/Servicios/FactuGES_Intf.pas | 199 +- Source/Servicios/FactuGES_Invk.pas | 396 ++- Source/Servicios/RODLFILE.res | Bin 40968 -> 42340 bytes .../Configuracion/srvConfiguracion_Impl.pas | 2 +- Source/Servidor/Configuracion/uConexionBD.pas | 5 +- Source/Servidor/FactuGES_Server.RES | Bin 23352 -> 23344 bytes Source/Servidor/FactuGES_Server.dproj | 564 ++-- Source/Servidor/FactuGES_Server.rc | 2 +- Source/Servidor/Utiles/uReferenciasUtils.pas | 36 +- Source/Servidor/srvLogin_Impl.pas | 3 +- 205 files changed, 6528 insertions(+), 4135 deletions(-) create mode 100644 Source/Cliente/VCLFixPack.pas 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 - - - - - - - - - - - - - - - - - - - - - - -
DataModuleEjercicios
 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 ffc8e64bf969e186d145a856fa6f51046b0d17be..2f1ab32a508454ba293c8df8fea3f13e7596b02f 100644 GIT binary patch delta 13 UcmX@idYE;C9TTJBWP7F-03Uq>3jhEB delta 13 UcmX@idYE;C9TTI$WP7F-03Ub+3IG5A 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 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
fConfigurarConexion
diff --git a/Source/Base/Base.res b/Source/Base/Base.res index 1641339fcc482e7e3492d1b45813a86619622c33..8b251f312bcccec5485024f6fe8d80e1cdf25746 100644 GIT binary patch delta 11 ScmeBCZD5|Duvteife`=|>;pCc literal 4748 zcmbW5&ub)A5XUPdpe&2#;C*uNAUVhgd+&(4um@dnom`vXF9g}ZuHJ;se=<3UNdFJg zbCw+UD9j$byGIXV`~6hC>h4S?F|k9X-j90q{Z_qtZ<;nUJCO8!h?p${kR>3GhM`oH*q zk=UsjOCIgA_4!`B+Gb&`I84R)bT4dy-BQV<-SyFz?R8ILEQ(+JB$u{sEXE@j@B*7W zT;iZH#|OJ<&DO$RCkM6VbK3(B(k{nbdv1lpc;E$xz9as|v3uE1V{hw2w~g3eD0an7 z{BT%G%irdMe*|oDJmgvJaA2`9B<6Xi*?M~Q;)@Sbfwf3uf zVaWkbUjU=;sL{BlYemIZXv%qZ{SZw{-TCU+;!nH6KDDIJumU+9{E0zXW4>7T)y|>$DQlv zRJe?TjSp{c!DqeayAnSMTtZZT;>LN7J0Rls+5m@q)MbyB*eL%Eu@(+$Cw}Pd@q7N| z%Q0*AHpCP^b9v`@jx-l_FD>khpW2W8(OU2&V5TrnoAY-m_hlcV?zq3;7{2gF{J#Hc z6R+o~mVenX?>@W0@_DVzyOFs(5464CY{!q9ChoF#_*eXi@4gFuV8?vhl=_w5$iKL0 zEV0nMBcN08xtRmsgJrqjh@s#|{?*ssnsG)mH*wa6{efF0JFWHok@kA5%b661{B38= zCcgJ|*ZFTpV$8<-&+AWpa)Q8*`wL&hMeNQ^v6I7$HSdLZhZ^&+6<@Uw_Zsml9^v3W zVvPDBKHh;i=RU4J_ta3E;)Mn>Y+L zKLZ0UQ+*km9FO-b?U4gmn-62iwzH6&*duKGo~aUV)bYDla8wWZ9+^7p-F<8lP@i!m z@vhbD_${F}h>^T;C(?(b*OJDk?{dEXB?nuehoON3HAb!7Mr7-ls!84-5V-jJugbu<_$}mU=Yd9!?TOX;|B-#B)+0x#9q*yqJiqS!`49d=7ztk$O+9=1i;?K_|J<8T z?0b7=-`Z3A#vV$4XJ5(lQ~TOZHUFdA%oWvK5zg&_IKXIbughQBA8XAsd#=@|TFLXC zy(^m((;DnQmDQKatmw!@c`| G?EMQ&4NnpP 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 9600a5ed786371044b485ac14b33804842b48349..ce0f4deabf99e1840124bbcaa2743506c25cdbf1 100644 GIT binary patch delta 64 zcmX>h@=;{NT4rt?UM>ZNm?yERD^#bsWG3e1r@Q8)re_wp`X*-PSSf_K U MainSource - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
fDialogBase
 - + +
fDialogElegirEMail
+ TForm +
fEditorBase
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 bf6268f0c101693dd4900681514769c1a1a41272..d3304256ee09a8cf46a63015bdb959500548065c 100644 GIT binary patch delta 13 UcmaFC@`7ct04j|Is{jB1 delta 13 UcmaFC@`7ct04j(DssI20 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 - - - - - + + + + +
fEditorArticulo
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 1f375ba51e5a9a052053c048f9d20693cdafbf10..5cbaaba2ef49f84aa0696bd8f5cec01d3352b619 100644 GIT binary patch delta 65 zcmcb{dY*N|D@GMgr^Mn^9bPU@_fSt5)3Kl+Co?&*Br`t`EHwEAqx@tErfEFZyj;9o Lsd*`Syj%(Zqze-D delta 74 zcmX@ldX06%E5^wJOtOMHyj%(jUS;k%`AMb4E{29dlXaP`v&@p7f+rRec;F#rIAoEHKB 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 - - - - - -
fEditorExportacionNorma19
- - - - 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 36f26e234a8ac66a47e95cec6d496cf2f1442471..8b251f312bcccec5485024f6fe8d80e1cdf25746 100644 GIT binary patch literal 384 zcmZ9HOA3Ne6ox;+L5PEv(4cV`IIrjdPAV##hV&wc1g%+%X(R2Xc{`~7t6e0Ioa?#% zkMj%AQhz>WYy7LeWAUaqx~Kv?-;(-Hs4-^ATIZOBrid9+-6Ne7&88mi>kUR4lo#jxZ;#*s4zxg9yNlk=H9sqkCD2^cEXKpiTBNfgkKpXJBWWaLt(Qkv@0 w5yv*t82((Wlr2{_+FDoDHKW2QCXvc+s**ul{{$ + + @@ -90,7 +92,6 @@ - @@ -99,32 +100,32 @@ -
fEditorComision
TfEditorComision +
fEditorComision
 -
fEditorComisiones
TfEditorComisiones +
fEditorComisiones
 -
fEditorComisionesPreview
TfEditorComision +
fEditorComisionesPreview
 -
frViewComision
TFrame +
frViewComision
 -
frViewComisiones
TFrame +
frViewComisiones
 -
frViewFacturasComision
TFrame +
frViewFacturasComision
 -
frViewVendedoresComision
TFrame +
frViewVendedoresComision
 diff --git a/Source/Modulos/Contabilidad/Controller/Contabilidad_controller.dpk b/Source/Modulos/Contabilidad/Controller/Contabilidad_controller.dpk index 3cc8593a4519a92f53aabc4eb546b06175b3ed10..4fb2af01483bd59ed1eca471d7ec119dc144ad58 100644 GIT binary patch delta 16 XcmX>mbXQ=*f5yrDOktbtm^s)0Iqn5= delta 243 zcmcaBa7<{!e@337k{lggE(L|M M7tr|40ZhDX04%#kw*UYD diff --git a/Source/Modulos/Contabilidad/Plugin/Contabilidad_plugin.dpk b/Source/Modulos/Contabilidad/Plugin/Contabilidad_plugin.dpk index 8480d9cf40027ed0598bbcebc48b0bd837c52a30..b9f28a57120f11f73f7464e00e4018edc2078c41 100644 GIT binary patch delta 13 UcmbQlHi>P60~4d+WJjip02^Kd`~Uy| delta 13 UcmbQlHi>P60~4dcWJjip02^5Y`v3p{ 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 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + +
frViewEpigrafes
TFrame @@ -161,7 +123,7 @@
fEditorExtractoMovimientos
- TfEditorEjercicios + TfEditorExtractoMovimientos
fEditorSubCuenta
@@ -223,13 +185,6 @@
frViewSubCuentas
TFrame - - - - - - -