unit menu; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus, Grids, DBGrids, Db, ExtCtrls, ComCtrls, OleCtrls, isp3, DBTables, FileCtrl, ToolWin, ActnList, ImgList, DBCtrls,MATH, jpeg,TIPOSDEFINIDOS ,DATEUTILS,QPRINTERS, System.Actions; type TFMENU = class(TForm) MainMenu1: TMainMenu; Mantenimiento1: TMenuItem; N1: TMenuItem; CLIENTES1: TMenuItem; SALIR1: TMenuItem; VARIOS1: TMenuItem; N7: TMenuItem; N8: TMenuItem; CONFIGURACIONPLANTA1: TMenuItem; StatusBar1: TStatusBar; Timer1: TTimer; PRESUPUESTO1: TMenuItem; TARIFASDESERVICIOS1: TMenuItem; N3: TMenuItem; FACTUR1: TMenuItem; OpenDialog1: TOpenDialog; ABONOS1: TMenuItem; ImageList2: TImageList; ActionList2: TActionList; APRESUPUESTO: TAction; AFacturas: TAction; AAbonos: TAction; AValorar: TAction; AClientes: TAction; APlantas: TAction; ASERIES: TAction; ACOLORES: TAction; AARTICULOS: TAction; APROVEEDOR: TAction; AFAMILIAS: TAction; AEmpresas: TAction; ALISTADOFACTURAS: TAction; Alistadoservicios: TAction; ASalir: TAction; ToolBar1: TToolBar; BPRESUPUESTO: TToolButton; ToolButton12: TToolButton; bclientes: TToolButton; ToolButton3: TToolButton; BARTICULOS: TToolButton; ToolButton14: TToolButton; BPROVEEDOR: TToolButton; BFAMILIAS: TToolButton; BEMPRESA: TToolButton; ToolButton15: TToolButton; Label4: TLabel; ToolButton16: TToolButton; Label6: TLabel; ToolButton18: TToolButton; AENTRADA: TAction; Series1: TMenuItem; BALBARAN: TToolButton; AALBARAN: TAction; ALBARAN1: TMenuItem; BFACTURA: TToolButton; AFACTURA: TAction; Factura1: TMenuItem; BFORMAPAGO: TToolButton; AFORMAPAGO: TAction; FORMADEPAGO1: TMenuItem; BCOBRO: TToolButton; ACOBRO: TAction; Cobro1: TMenuItem; Image1: TImage; ToolBar2: TToolBar; Label1: TLabel; Ver1: TMenuItem; Asesoft1: TMenuItem; ATARIFAS: TAction; AACTUALIZARTARIFAS: TAction; AALMACEN: TAction; ASALIDAS: TAction; AAVISOS: TAction; APEDIDOSPENDIENTES: TAction; aanyo: TAction; TBOPCIONES: TToolButton; AOPCIONES: TAction; Button1: TButton; Button2: TButton; Button3: TButton; aarqueodecaja: TAction; LISTADOS1: TMenuItem; ArticulosVendidos1: TMenuItem; Cobros1: TMenuItem; Albaranes1: TMenuItem; Facturas1: TMenuItem; EntradasTotal1: TMenuItem; EntradasArticulos1: TMenuItem; Almacen1: TMenuItem; Avisos1: TMenuItem; Pendientes1: TMenuItem; Avisos2: TMenuItem; Familias1: TMenuItem; Empresas1: TMenuItem; Series2: TMenuItem; FormadePago2: TMenuItem; OPCIONES1: TMenuItem; Entrada1: TMenuItem; Salidas1: TMenuItem; Almacen2: TMenuItem; Pendiente1: TMenuItem; ATICKET: TAction; ACALCULARFAMILIAS: TAction; aarticulosvendidos: TAction; N2: TMenuItem; icket1: TMenuItem; CalcularFamilias1: TMenuItem; ArticulosVendidos2: TMenuItem; ArqueoCaja1: TMenuItem; ToolButton7: TToolButton; ToolButton10: TToolButton; ToolButton11: TToolButton; ToolButton17: TToolButton; ToolButton25: TToolButton; ToolButton26: TToolButton; ToolButton27: TToolButton; Label2: TLabel; ToolButton1: TToolButton; procedure CLIENTES1Click(Sender: TObject); procedure SALIR1Click(Sender: TObject); procedure FormShow(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure CONTROLCONFIGURACION1Click(Sender: TObject); procedure CAMIONES1Click(Sender: TObject); procedure CONDUCTORES1Click(Sender: TObject); procedure COLORES1Click(Sender: TObject); procedure PRESUPUESTO1Click(Sender: TObject); procedure TARIFASDESERVICIOS1Click(Sender: TObject); procedure SERIES1Click(Sender: TObject); procedure PLANTAS1Click(Sender: TObject); procedure CONFIGURACIONPLANTA1Click(Sender: TObject); procedure ABONOS1Click(Sender: TObject); procedure FormActivate(Sender: TObject); procedure BVISTACLIENTEClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure BEntradaClick(Sender: TObject); procedure BALBARANClick(Sender: TObject); procedure BFACTURAClick(Sender: TObject); procedure BFORMAPAGOClick(Sender: TObject); procedure BCOBROClick(Sender: TObject); procedure Asesoft1Click(Sender: TObject); procedure Image1Click(Sender: TObject); procedure BTARIFASClick(Sender: TObject); procedure BACTUALIZARTARIFASClick(Sender: TObject); procedure BALMACENClick(Sender: TObject); procedure BSALIDASClick(Sender: TObject); procedure AAVISOSExecute(Sender: TObject); procedure APEDIDOSPENDIENTESExecute(Sender: TObject); procedure aanyoExecute(Sender: TObject); PROCEDURE APPMESSAGE(VAR MSG:TMSG; VAR HANDLED:BOOLEAN); procedure AOPCIONESExecute(Sender: TObject); procedure Button1Click(Sender: TObject); procedure ToolButton23Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure aarqueodecajaExecute(Sender: TObject); procedure ArticulosVendidos1Click(Sender: TObject); procedure Cobros1Click(Sender: TObject); procedure Albaranes1Click(Sender: TObject); procedure Facturas1Click(Sender: TObject); procedure EntradasTotal1Click(Sender: TObject); procedure EntradasArticulos1Click(Sender: TObject); procedure Almacen1Click(Sender: TObject); procedure Avisos1Click(Sender: TObject); procedure Pendientes1Click(Sender: TObject); procedure Avisos2Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure ATICKETExecute(Sender: TObject); procedure ACALCULARFAMILIASExecute(Sender: TObject); procedure aarticulosvendidosExecute(Sender: TObject); procedure ToolButton26Click(Sender: TObject); procedure ToolButton1Click(Sender: TObject); private { Private declarations } function KillTask(FileName:String):integer; public { Public declarations } // TRANSACTION:INTEGER; VISTACLIENTE : BOOLEAN; IVA,MOSTRARIMAGEN,MOSTRARDESCRIPCION,FPOSICION,FPOSICIONUSO,FDESCRIPCION,ID_EMPRESA,ANYO,NOMBREEMPRESA,CIF_EMPRESA,LOGO,ID_SERIE,TIPO,DAR_AVISO,TICKET,VPREVIO:STRING; IMPRIMIRTICKET,ID_FORMAPAGO,DESFASEARQUEO,IMPRESORATICKET,IMPRESORAINFORMES,EXISTECAJA,PUERTOTIQUETS,IMPRIMIRFACTURA,COPIASFACTURA,ALBSINIVA:STRING; IMPRIMIRALBARAN,COPIASALBARAN:STRING; PATHDBGRID:STRING; ESTICKET:BOOLEAN; NODESCONTAR,CLXDEFECTO:STRING; VALIDEZ:SMALLINT; function MostrarModal(ClaseVentana:TFormclass):integer; function HIJA(ClaseVentana:TFormClass):boolean; PROCEDURE CERRARHIJAS; PROCEDURE CERRARTODAS; PROCEDURE CERRARHIJA(CLASEVENTANA:TFORMCLASS); PROCEDURE CAMBIO; PROCEDURE ASIGNARVARIABLES; PROCEDURE ASIGNARVARIABLESAUX; PROCEDURE CAMBIARANYO(AUX:STRING); function impresorapordefecto(aux:string):string; procedure impresorainicial(aux:string); end; var FMENU: TFMENU; implementation uses UDMGS, FDLGEMPRESAAUX, DLGFECHAS, fclientes, FFAMILIAS, FPROVEEDOR, FCOLORES, FPRESUPUESTO, FTARIFAS, FARTICULOS, FSERIES, FEMPRESA, FPEDIDOSPENDIENTES, FENTRADA, FALBARAN, FFACTURA, FFORMAPAGO, FCOBRO, fasesoft, FACTUALIZARTARIFAS, FALMACEN, fsalida, FAVISO, FTICKET, fdlganyo, FOPCIONESNUMERICAS, FFAMILIA, fconfiguracion, FLISTADOOOPCIONESARITCULOS, FLISTADOS, fprevio, FARQUEODECAJA, FLISTADOOPCIONEScobro, FLISTADOOPCIONES, FLISTADOENTRADAS, FLISTADOOPCIONESALMACEN, FLISTADOOOPCIONESTICKET, FLISTADOOPCIONESPENDIENTES, FLISTADOOPCIONESAVISO, shellAPI,TLHelp32, FTIPOSIVA; //uses ; { uses FCLIENTES,FFORPAGO,FCONDUCTORES,FCAMIONES, FLISCAM, DLGFECHAS, FACTURAR, SERVICIOS, RUTINAS, FSOCIEDADES, FACTURAR3, FmxUtils, ABONOS, FPROVEEDOR, FFAMILIAS, FARTICULOS, FCOLORES, FEMPRESA, FSERIES, FPRESUPUESTO, FDLGEMPRESAAUX, UDMGS, FENTRADA, FALBARAN, FFACTURA, FFORMAPAGO, FCOBRO, fasesoft, FTARIFAS, FACTUALIZARTARIFAS, FALMACEN, fsalida, FAVISO, FPEDIDOSPENDIENTES, FTICKET; } {$R *.DFM} procedure TFMENU.CLIENTES1Click(Sender: TObject); begin if not Hija(TCLIENTES) then TCLIENTES.Create(self); // MostrarModal(TClientes); end; procedure TFMENU.SALIR1Click(Sender: TObject); begin close; end; procedure TFMENU.FormShow(Sender: TObject); begin image1.Align := altop; image1.Align := alnone; dateseparator:='/'; shortdateformat:='dd/mm/yyyy'; VISTACLIENTE := FALSE; // RETIFICARLO COMO ESTA EN EL ARCHIVO // GESTISHOP POR HACER with dmgs.cdsq_empresaaux do begin close; dmgs.VEMPRESASAUX.ID := '%'; dmgs.VEMPRESASAUX.TIPO := '1'; open; end; if dmgs.cdsq_empresaaux.RecordCount =1 then begin ASIGNARVARIABLESAUX; // LOGO := DMGS.CDSQ_EMPRESALOGO.AsString; dmgs.cdsq_empresaaux.close; end else begin DLGEMPRESAAUX := TDLGEMPRESAAUX.CREATE(NIL); IF DLGEMPRESAAUX.SHOWMODAL = MROK THEN BEGIN ASIGNARVARIABLESAUX; // LOGO := DMGS.CDSQ_EMPRESALOGO.AsString; END ELSE SELF.Close; DLGEMPRESAAUX.FREE; DLGEMPRESAAUX := NIL; end; SELF.Caption := ' GESTISHOP - '+ NOMBREEMPRESA + ' - ' + ID_SERIE ; // lo quito revisión version 2.0 para que no tarde tanto arrancar // familia.crearfamilia(0,familia,DMGS.CDSQ_FAMILIASAUX); end; procedure TFMENU.FormClose(Sender: TObject; var Action: TCloseAction); begin while (SELF.MDICHILDCOUNT > 0) do SELF.MDIChildren[SELF.MDIChildCount -1].Free; end; procedure TFMENU.CONTROLCONFIGURACION1Click(Sender: TObject); begin // MostrarModal(TPlantas); end; procedure TFMENU.CAMIONES1Click(Sender: TObject); begin if not Hija(TFAMILIAS) then TFAMILIAS.Create(self); end; procedure TFMENU.CONDUCTORES1Click(Sender: TObject); begin if not Hija(TPROVEEDOR) then TPROVEEDOR.Create(self); end; function TFMENU.MostrarModal(ClaseVentana:TFormClass):integer; begin with ClaseVentana.Create(Self) do try result:=Showmodal; finally Free; end; end; procedure TFMENU.COLORES1Click(Sender: TObject); begin // MostrarModal(TFServicios); if not Hija(TCOLORES)then TCOLORES.create(self); end; procedure TFMENU.PRESUPUESTO1Click(Sender: TObject); begin // MostrarModal(TFALBASER); if not Hija(tPRESUPUESTO)then TPRESUPUESTO.create(self); end; procedure TFMENU.TARIFASDESERVICIOS1Click(Sender: TObject); begin // MostrarModal(TFTarifasSer); if not Hija(TARTICULOS)then TARTICULOS.create(self); end; procedure TFMENU.SERIES1Click(Sender: TObject); begin if not Hija(TSERIES)then TSERIES.create(self); end; procedure TFMENU.PLANTAS1Click(Sender: TObject); begin // MostrarModal(TPLANTAS); { if not Hija(tplantas) then tplantas.Create(self); } end; procedure TFMENU.CONFIGURACIONPLANTA1Click(Sender: TObject); begin // SOCIEDADES.SHOWMODAL; if not Hija(tempresa) then tempresa.Create(self); end; procedure TFMENU.ABONOS1Click(Sender: TObject); begin // if not Hija(TFABONOS) then // TFABONOS.Create(self); end; Function tfmenu.HIJA(ClaseVentana:TFormclass):boolean; var i,j:integer; esta,estado:boolean; begin estado := false; esta := false; j :=self.MDIChildCount -1; i := 0; while (i<=j) and (not esta) do begin if self.MDIChildren [i].WindowState = wsmaximized then estado:= true; if (self.MDIChildren [i] is ClaseVentana) then begin esta := true; end; i:=i+1; end; if esta then // ClaseVentana.Create(self) // else begin self.MDIChildren[i-1].ActiveMDIChild; // if self.mdichildren[i-1].WindowState = wsminimized then if estado then begin self.MDIChildren [i-1].WindowState := wsMaximized; self.mdichildren [0].bringtofront; end else begin self.MDIChildren [i-1].WindowState := wsNormal; self.MDIChildren[i-1].BringToFront; end; end; result := esta; if (claseventana <> TTARIFAS) or (claseventana <> TPRESUPUESTO) or (claseventana <> TPEDIDOSPENDIENTES) THEN STATUSBAR1.SimpleText := ''; end; procedure TFMENU.FormActivate(Sender: TObject); begin //hola end; procedure TFMENU.BVISTACLIENTEClick(Sender: TObject); begin { IF NOT VISTACLIENTE THEN VISTACLIENTE := TRUE ELSE VISTACLIENTE := FALSE; } end; procedure TFMENU.FormCreate(Sender: TObject); VAR AUX:TPRINTER; begin // LO QUITO MIENTRAS ESTOY HACIENDO PRUEBAS // ******************************************* // ShellExecute(menu.Handle, nil, 'sgestishop.exe', nil, nil, SW_SHOWNORMAL); // ******************************************* // TRANSACTION := -1; sleep(2000); APPLICATION.OnMessage := APPMESSAGE; AUX := TPRINTER.CREATE; // DECIMALSEPARATOR := ','; CurrencyDecimals := 3 ; TIPO :='0'; ESTICKET := FALSE; // APDCOMPORT1.Open := TRUE ; PATHDBGRID := 'c:\gestishop\dbgrid';; //if sDir path does not exist, create it! if NOT DirectoryExists(PATHDBGRID) then ForceDirectories(PATHDBGRID); end; procedure TFMENU.FormDestroy(Sender: TObject); begin // FOR I:=0 TO SCREEN.FormCount -1 DO // IF (SCREEN.Forms[I].Name[1] = 'F') // AND (SCREEN.Forms[I].Name <> 'FMENU') // THEN // SCREEN.FORMS[I].FREE; // DECIMALSEPARATOR := '.'; CurrencyDecimals := 2 ; // APDCOMPORT1.Open := FALSE ; KillTask('sgestishop.exe'); end; procedure TFMENU.BEntradaClick(Sender: TObject); begin if not Hija(tentrada) then tentrada.Create(self); end; PROCEDURE TFMENU.CERRARHIJAS ; BEGIN while (SELF.MDICHILDCOUNT > 1) do IF SELF.MDIChildren [SELF.MDIChildCount -1 ].Name <> 'EMPRESA' THEN SELF.MDIChildren[SELF.MDIChildCount -1].Free; END; procedure TFMENU.BALBARANClick(Sender: TObject); begin if not Hija(talbaran) then talbaran.Create(self); end; procedure TFMENU.BFACTURAClick(Sender: TObject); begin if not Hija(tfactura) then tfactura.Create(self); end; procedure TFMENU.BFORMAPAGOClick(Sender: TObject); begin if not Hija(tformapago) then tformapago.Create(self); end; procedure TFMENU.BCOBROClick(Sender: TObject); VAR I:INTEGER; begin { IF SELF.MDIChildCount > 0 THEN BEGIN IF SELF.ActiveMDIChild.Name = 'FACTURA' THEN BEGIN if not Hija(tcobro) then tcobro.Create(self); IF (DMGS.CDSQ_MDFACTURA.ACTIVE) AND (DMGS.CDSQ_MDFACTURA.RecordCount > 0 ) THEN BEGIN WITH DMGS.CDSQ_MDCOBRO DO BEGIN CLOSE; DMGS.COBGRID :=' WHERE ID_EMPRESA='+DMGS.CDSQ_MDFACTURAID_EMPRESA.ASSTRING+' AND ANYO ='+ DMGS.CDSQ_MDFACTURAANYO.ASSTRING + ' AND ID='+DMGS.CDSQ_MDFACTURAID_FACTURA.ASSTRING+' AND ID_SERIE='''+DMGS.CDSQ_MDFACTURAID_SERIE.ASSTRING+''' AND TIPO=''FACTURA'' ' ; DMGS.COBGRTIPO :='2'; OPEN; IF DMGS.CDSQ_MDCOBRO.RecordCount = 0 THEN BEGIN APPEND; DMGS.CDSQ_MDCOBROID.AsString := DMGS.CDSQ_MDFACTURAID_FACTURA.ASSTRING; DMGS.CDSQ_MDCOBROBASE.VALUE := roundto((DMGS.CDSQ_MDFACTURABASE_FACTURA.VALUE) - (DMGS.CDSQ_MDFACTURABASE_FACTURA.VALUE*DMGS.CDSQ_MDFACTURADESCUENTO.VALUE/100),-5); dmgs.cdsq_mdcobrotipo.asstring:= 'FACTURA'; dmgs.cdsq_mdcobroID_cliente.asstring := dmgs.cdsq_mdfacturaid_CLIENTE.ASSTRING; dmgs.cdsq_mdcobroID_SERIE.asstring := dmgs.cdsq_mdfacturaid_SERIE.ASSTRING; dmgs.cdsq_mdcobroANYOSERIE.asstring := dmgs.cdsq_mdfacturaANYO.ASSTRING; DMGS.CDSQ_MDCOBROOBSERVACIONES.FocusControl ; END; END; END; END //***********************************************************************// ELSE IF SELF.ActiveMDIChild.Name = 'ALBARAN' THEN BEGIN if not Hija(tcobro) then tcobro.Create(self); { IF (DMGS.CDSQ_MDALBARAN.ACTIVE) AND (DMGS.CDSQ_MDALBARAN.RecordCount > 0 ) THEN BEGIN WITH DMGS.CDSQ_MDCOBRO DO BEGIN CLOSE; DMGS.COBGRID :=' WHERE ID_EMPRESA='+DMGS.CDSQ_MDALBARANID_EMPRESA.ASSTRING+' AND ANYO ='+ DMGS.CDSQ_MDALBARANANYO.ASSTRING + ' AND ID='+DMGS.CDSQ_MDALBARANID_ALBARAN.ASSTRING+' AND ID_SERIE='''+DMGS.CDSQ_MDALBARANID_SERIE.ASSTRING+''' AND TIPO=''ALBARAN'' ' ; DMGS.COBGRTIPO :='2'; OPEN; IF DMGS.CDSQ_MDCOBRO.RecordCount = 0 THEN BEGIN APPEND; DMGS.CDSQ_MDCOBROID.AsString := DMGS.CDSQ_MDALBARANID_ALBARAN.ASSTRING; DMGS.CDSQ_MDCOBROBASE.VALUE := roundto((DMGS.CDSQ_MDalbaranBASE_albaran.VALUE) - (DMGS.CDSQ_MDalbaranBASE_albaran.VALUE*DMGS.CDSQ_MDalbaranDESCUENTO.VALUE/100),-5);; dmgs.cdsq_mdcobrotipo.asstring:= 'ALBARAN'; dmgs.cdsq_mdcobroID_cliente.asstring := dmgs.cdsq_mdALBARANid_CLIENTE.ASSTRING; dmgs.cdsq_mdcobroID_SERIE.asstring := dmgs.cdsq_mdALBARANid_SERIE.ASSTRING; dmgs.cdsq_mdcobroANYOSERIE.asstring := dmgs.cdsq_mdALBARANANYO.ASSTRING; DMGS.CDSQ_MDCOBROOBSERVACIONES.FocusControl ; END; END; END; END ELSE if not Hija(tcobro) then tcobro.Create(self); END ELSE } if not Hija(tcobro) then tcobro.Create(self); end; procedure TFMENU.CAMBIO; begin CERRARHIJAS; IF TIPO='0' THEN BEGIN TIPO:='1'; TOOLBAR2.Visible := TRUE; END ELSE BEGIN TIPO:='0'; TOOLBAR2.Visible := FALSE; END; with dmgs.cdsq_empresaaux do begin close; dmgs.VEMPRESASAUX.ID := '%'; dmgs.VEMPRESASAUX.TIPO := '1'; open; end; If dmgs.cdsq_empresaaux.RecordCount =0 then begin if not Hija(tempresa) then tempresa.Create(self); TICKET := ''; VPREVIO :=''; ID_EMPRESA := ''; IVA:=''; CLXDEFECTO:=''; ID_FORMAPAGO := ''; ANYO:=''; ALBSINIVA:=''; EXISTECAJA:=''; PUERTOTIQUETS:=''; IMPRIMIRFACTURA:=''; COPIASFACTURA:=''; IMPRIMIRALBARAN:=''; COPIASALBARAN:=''; IMPRESORATICKET:=''; IMPRESORAINFORMES:=''; DESFASEARQUEO:='0'; MOSTRARIMAGEN:=''; MOSTRARDESCRIPCION:=''; FPOSICION:=''; FPOSICIONUSO:=''; FDESCRIPCION:=''; NOMBREEMPRESA := ''; CIF_EMPRESA := ''; DAR_AVISO := '0'; ID_SERIE := ''; NODESCONTAR := ''; VALIDEZ := 30; IMPRIMIRTICKET := '0'; Caption := ' GESTISHOP - '; end else If dmgs.cdsq_empresaaux.RecordCount =1 then begin ASIGNARVARIABLESAUX; // LOGO := DMGS.CDSQ_EMPRESALOGO.AsString; dmgs.cdsq_empresaaux.close; end else begin DLGEMPRESAAUX := TDLGEMPRESAAUX.CREATE(NIL); IF DLGEMPRESAAUX.SHOWMODAL = MROK THEN BEGIN ASIGNARVARIABLESAUX; // LOGO := DMGS.CDSQ_EMPRESALOGO.AsString; END ELSE SELF.Close; DLGEMPRESAAUX.FREE; DLGEMPRESAAUX := NIL; end; SELF.Caption := ' GESTISHOP - '+ NOMBREEMPRESA + ' - ' + ID_SERIE ; // IF (TIPO='1') THEN // SELF.CAPTION := SELF.Caption + ' AUXILIAR '; end; procedure TFMENU.Asesoft1Click(Sender: TObject); begin if not Hija(tasesoft) then tasesoft.Create(self); end; procedure TFMENU.Image1Click(Sender: TObject); VAR I:INTEGER; begin { with DMGS.CDSQ_MDPRESUPUESTO do BEGIN DMGS.CDSQ_MDLINPRESUPUESTO.Close; Close; DMGS.PRBGRID :='%'; DMGS.PRBGRTIPO := '1'; DMGS.PRBGRORDEN := ordenpresupuesto;// ' ORDER BY ID_CLIENTE, FECHA,ID_PRESUPUESTO '; DMGS.PRBGRORDENLINEA := ordenlinpresupuesto; Open; END; WHILE NOT DMGS.CDSQ_MDPRESUPUESTO.EOF DO BEGIN DMGS.CDSQ_MDPRESUPUESTO.Last; IF DMGS.CDSQ_MDPRESUPUESTO.EOF THEN try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_MDPRESUPUESTO.GetNextPacket; except end; END; DMGS.CDSQ_MDPRESUPUESTO.First; WHILE NOT DMGS.CDSQ_MDPRESUPUESTO.Eof DO BEGIN DMGS.CDSQ_MDLINPRESUPUESTO.First; I := 100; WHILE NOT DMGS.CDSQ_MDLINPRESUPUESTO.EOF DO BEGIN DMGS.CDSQ_MDLINPRESUPUESTO.Edit; DMGS.CDSQ_MDLINPRESUPUESTOLINEA.Value := I; DMGS.linpresupuestonopregunta := TRUE; DMGS.CDSQ_MDLINPRESUPUESTO.Post; DMGS.CDSQ_MDLINPRESUPUESTO.NEXT; I:= I+1; END; DMGS.CDSQ_MDPRESUPUESTO.Next; END; showmessage('ACTUALIZACION PRESUPUESTO COMPLETA'); // VOY POR AQUI PERO VOY A PONER PRIMERO EL ORDEN. with DMGS.CDSQ_MDALBARAN do BEGIN DMGS.CDSQ_MDLINEAALBARAN.Close; Close; DMGS.ALBGRID :='%'; DMGS.ALBGRTIPO := '1'; dmgs.ALBGRORDEN := ordenalbaran; DMGS.ALBGRORDENLINEA := ORDENLINEAALBARAN; Open; END; WHILE NOT DMGS.CDSQ_MDALBARAN.EOF DO BEGIN DMGS.CDSQ_MDALBARAN.Last; IF DMGS.CDSQ_MDALBARAN.EOF THEN try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_MDALBARAN.GetNextPacket; except end; END; DMGS.CDSQ_MDALBARAN.First; WHILE NOT DMGS.CDSQ_MDALBARAN.Eof DO BEGIN DMGS.CDSQ_MDLINEAALBARAN.First; I := 100; WHILE NOT DMGS.CDSQ_MDLINEAALBARAN.EOF DO BEGIN DMGS.CDSQ_MDLINEAALBARAN.Edit; DMGS.CDSQ_MDLINEAALBARANLINEA.Value := I; DMGS.LINEAALBARANnopregunta := TRUE; DMGS.CDSQ_MDLINEAALBARAN.Post; DMGS.CDSQ_MDLINEAALBARAN.NEXT; I:= I+1; END; DMGS.CDSQ_MDALBARAN.Next; END; showmessage('ACTUALIZACION ALBARAN COMPLETA'); with DMGS.CDSQ_MDFACTURA do BEGIN DMGS.CDSQ_MDLINEAFACTURA.Close; Close; DMGS.FCBGRID :='%'; DMGS.FCBGRTIPO := '1'; dmgs.FCBGRORDEN := ordenFACTURA; DMGS.FCBGRORDENLINEA := ORDENLINEAFACTURA; Open; END; WHILE NOT DMGS.CDSQ_MDFACTURA.EOF DO BEGIN DMGS.CDSQ_MDFACTURA.Last; IF DMGS.CDSQ_MDFACTURA.EOF THEN try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_MDFACTURA.GetNextPacket; except end; END; DMGS.CDSQ_MDFACTURA.First; WHILE NOT DMGS.CDSQ_MDFACTURA.Eof DO BEGIN DMGS.CDSQ_MDLINEAFACTURA.First; I := 100; WHILE NOT DMGS.CDSQ_MDLINEAFACTURA.EOF DO BEGIN DMGS.CDSQ_MDLINEAFACTURA.Edit; DMGS.CDSQ_MDLINEAFACTURALINEA.Value := I; DMGS.LINEAFACTURAnopregunta := TRUE; DMGS.CDSQ_MDLINEAFACTURA.Post; DMGS.CDSQ_MDLINEAFACTURA.NEXT; I:= I+1; END; DMGS.CDSQ_MDFACTURA.Next; END; showmessage('ACTUALIZACION FACTURA COMPLETA'); } end; procedure TFMENU.BTARIFASClick(Sender: TObject); begin if not Hija(TTARIFAS) then TTARIFAS.Create(self); end; procedure TFMENU.BACTUALIZARTARIFASClick(Sender: TObject); begin if not Hija(tACTUALIZARTARIFAS) then TACTUALIZARTARIFAS.Create(self); end; PROCEDURE tfmenu.CERRARHIJA(ClaseVentana:TFormclass); var i,j:integer; esta,estado:boolean; begin estado := false; esta := false; j :=self.MDIChildCount -1; i := 0; while (i<=j) and (not esta) do begin if self.MDIChildren [i].WindowState = wsmaximized then estado:= true; if (self.MDIChildren [i] is ClaseVentana) then esta := true; i:=i+1; end; if esta then self.MDIChildren[i-1].FREE; end; procedure TFMENU.BALMACENClick(Sender: TObject); begin CERRARHIJA(TALMACEN); if not Hija(talmacen) then talmacen.Create(self); end; procedure TFMENU.BSALIDASClick(Sender: TObject); begin if not Hija(TSALIDA) then TSALIDA.Create(self); end; procedure TFMENU.AAVISOSExecute(Sender: TObject); begin if not Hija(TAVISO) then TAVISO.Create(self); end; procedure TFMENU.APEDIDOSPENDIENTESExecute(Sender: TObject); begin if not Hija(TPEDIDOSPENDIENTES) then TPEDIDOSPENDIENTES.Create(self); end; PROCEDURE TFMENU.ASIGNARVARIABLES ; BEGIN ID_EMPRESA := DMGS.CDSQ_EMPRESAID_EMPRESA.ASSTRING; IVA := '21'; NOMBREEMPRESA := DMGS.CDSQ_EMPRESANOMBRE.ASSTRING; CIF_EMPRESA := DMGS.CDSQ_EMPRESACIF_EMPRESA.ASSTRING; ID_SERIE := DMGS.CDSQ_EMPRESAID_SERIE.AsString; VALIDEZ := DMGS.CDSQ_EMPRESAPRESUPUESTOVALIDO.VALUE; DAR_AVISO := DMGS.CDSQ_EMPRESADAR_AVISO.AsString; ALBSINIVA := DMGS.CDSQ_EMPRESAALBSINIVA.AsString; ANYO:= INTTOSTR(YEAROF(DATE));// FALTA PONER ANYO EN LA TABLA EXISTECAJA:=DMGS.CDSQ_EMPRESACAJA.ASSTRING; PUERTOTIQUETS:=DMGS.CDSQ_EMPRESAPUERTOIMPTICKET.ASSTRING; IMPRIMIRFACTURA :=DMGS.CDSQ_EMPRESAIMPRIMIRFACTURA.ASSTRING; if copiasfactura='' then copiasfactura:='1'; IMPRIMIRALBARAN :=DMGS.CDSQ_EMPRESAIMPRIMIRALBARAN.ASSTRING; COPIASALBARAN :=DMGS.CDSQ_EMPRESACOPIASALBARAN.ASSTRING; if copiasalbaran='' then copiasalbaran:='1'; MOSTRARIMAGEN:= DMGS.CDSQ_EMPRESAMOSTRARIMAGEN.ASSTRING; MOSTRARDESCRIPCION:=DMGS.CDSQ_EMPRESAMOSTRARDESCRIPCION.ASSTRING; FPOSICION:= DMGS.CDSQ_EMPRESAFPOSICION.ASSTRING; FPOSICIONUSO:= DMGS.CDSQ_EMPRESAFPOSICIONUSO.ASSTRING; FDESCRIPCION:= DMGS.CDSQ_EMPRESAFDESCRIPCION.ASSTRING; NODESCONTAR := DMGS.CDSQ_EMPRESANODESCONTAR.AsString;// NO DESCONTAR DE ALMACEN TICKET := DMGS.CDSQ_EMPRESATICKET.AsString; // IMPRIMIR TICKET COPIAS. VPREVIO := DMGS.CDSQ_EMPRESAPREVIOS.AsString; CLXDEFECTO := DMGS.CDSQ_EMPRESACLXDEFECTO.AsString ; IMPRIMIRTICKET := DMGS.CDSQ_EMPRESAIMPRIMIRTICKET.AsString ; ID_FORMAPAGO := DMGS.CDSQ_EMPRESAFORMAPAGO.AsString ; DESFASEARQUEO := DMGS.CDSQ_EMPRESADESFASEARQUEO.AsString ; LABEL2.Caption := ANYO; IMPRESORATICKET := DMGS.CDSQ_EMPRESAIMPRESORATICKET.ASSTRING; IMPRESORAINFORMES := DMGS.CDSQ_EMPRESAIMPRESORAINFORMES.ASSTRING; END; PROCEDURE TFMENU.ASIGNARVARIABLESAUX ; var aux :tprinter; I:integer; BEGIN ID_EMPRESA := DMGS.CDSQ_EMPRESAAUXID_EMPRESA.ASSTRING; IVA := '21'; NOMBREEMPRESA := DMGS.CDSQ_EMPRESAAUXNOMBRE.ASSTRING; CIF_EMPRESA := DMGS.CDSQ_EMPRESAauxCIF_EMPRESA.ASSTRING; ID_SERIE := DMGS.CDSQ_EMPRESAauxID_SERIE.AsString; VALIDEZ := DMGS.CDSQ_EMPRESAAUXPRESUPUESTOVALIDO.VALUE; DAR_AVISO := DMGS.CDSQ_EMPRESAAUXDAR_AVISO.AsString; NODESCONTAR := DMGS.CDSQ_EMPRESAAUXNODESCONTAR.AsString; ANYO := INTTOSTR(YEAROF(DATE)); EXISTECAJA := DMGS.CDSQ_EMPRESAAUXCAJA.ASSTRING; ALBSINIVA := DMGS.CDSQ_EMPRESAAUXALBSINIVA.ASSTRING; IMPRIMIRFACTURA := DMGS.CDSQ_EMPRESAAUXIMPRIMIRFACTURA.ASSTRING; PUERTOTIQUETS:=DMGS.CDSQ_EMPRESAAUXPUERTOIMPTICKET.ASSTRING; COPIASFACTURA := DMGS.CDSQ_EMPRESAAUXCOPIAS_FACTURAS.ASSTRING; IMPRIMIRALBARAN := DMGS.CDSQ_EMPRESAAUXIMPRIMIRALBARAN.ASSTRING; COPIASALBARAN := DMGS.CDSQ_EMPRESAAUXCOPIASALBARAN.ASSTRING; if copiasfactura='' then copiasfactura:='1'; if copiasalbaran='' then copiasalbaran:='1'; MOSTRARIMAGEN:= DMGS.CDSQ_EMPRESAAUXMOSTRARIMAGEN.ASSTRING; MOSTRARDESCRIPCION:=DMGS.CDSQ_EMPRESAAUXMOSTRARDESCRIPCION.ASSTRING; FPOSICION:= DMGS.CDSQ_EMPRESAAUXFPOSICION.ASSTRING; FPOSICIONUSO:= DMGS.CDSQ_EMPRESAAUXFPOSICIONUSO.ASSTRING; FDESCRIPCION:= DMGS.CDSQ_EMPRESAAUXFDESCRIPCION.ASSTRING; TICKET := DMGS.CDSQ_EMPRESAAUXTICKET.AsString; VPREVIO := DMGS.CDSQ_EMPRESAauxPREVIOS.AsString; CLXDEFECTO := DMGS.CDSQ_EMPRESAAUXCLXDEFECTO.AsString ; IMPRIMIRTICKET := DMGS.CDSQ_EMPRESAAUXIMPRIMIRTICKET.AsString ; ID_FORMAPAGO :=DMGS.CDSQ_EMPRESAAUXFORMAPAGO.AsString ; DESFASEARQUEO :=DMGS.CDSQ_EMPRESAAUXDESFASEARQUEO.AsString ; IMPRESORATICKET := DMGS.CDSQ_EMPRESAAUXIMPRESORATICKET.ASSTRING; IMPRESORAINFORMES := DMGS.CDSQ_EMPRESAAUXIMPRESORAINFORMES.ASSTRING; LABEL2.Caption := ANYO; END; procedure TFMENU.aanyoExecute(Sender: TObject); begin dlganyo:=tdlganyo.create(nil); dlganyo.Showmodal; dlganyo.Free; dlganyo := nil; end; PROCEDURE TFMENU.CAMBIARANYO(AUX:STRING); BEGIN cerrarTODAS; ANYO := AUX; LABEL2.Caption := ANYO; END; PROCEDURE TFMENU.CERRARTODAS ; BEGIN while (SELF.MDICHILDCOUNT > 0) do SELF.MDIChildren[SELF.MDIChildCount -1].Free; END; procedure TFMENU.AppMessage(var Msg: TMSg; Var Handled:Boolean); var actual : TWincontrol; begin if Msg.message = WM_KEYDOWN then begin // esto es para controlar que con la flecha abajo se desplegen las // listas if Msg.wParam = VK_DOWN then begin Actual := Screen.ActiveControl; if Actual is TDBLookupComboBox then if not TDBLookupComboBox(Screen.ActiveForm.ActiveControl).listVisible then TDBLookupComboBox(Screen.ActiveForm.ActiveControl).DropDown; // si utilizas las RX { if Actual is TRxDBLookupCombo then if not TRxDBLookupCombo(Screen.ActiveForm.ActiveControl).listVisible then TRxDBLookupCombo(Screen.ActiveForm.ActiveControl).DropDown; } if Actual is TComboBox then SendMessage(TComboBox(Screen.ActiveForm.ActiveControl).Handle,CB_SHOWDROPDOWN,-1,0); // se pueden añadir mas controles.... end; // CUANDO LE DOY A INTRO DENTRO DEL MEMO IF MSG.WPARAM = VK_RETURN THEN BEGIN Actual := Screen.ActiveControl; if (Actual is TCustomMemo) and (HiWord(GetKeyState(VK_CONTROL)) = 0)then Msg.wParam := VK_TAB; END; // y aqui es el control del TABULADOR. if Msg.wParam = VK_TAB THEN begin Actual := Screen.ActiveControl; // para los edit. if (Actual is TCustomEdit) and not (Actual is TCustomMemo) then Msg.wParam := VK_RETURN; // para los memo. Con ctrl + enter se salta de linea dentro del // memo, si solo es intro salta al siguiente control if (Actual is TCustomMemo) and (HiWord(GetKeyState(VK_CONTROL)) = 0)then Msg.wParam := VK_TAB; // para los lookup if Actual is TDBLookupComboBox then if not TDBLookupComboBox(Actual).listVisible then Msg.wParam := VK_RETURN; // Si utilizas las RX { if Actual is TRxDBLookupCombo then if not TRxDBLookupCombo(Actual).listVisible then Msg.wParam := VK_RETURN; } // Los combobox if Actual is TCustomComboBox then if not TCustomComboBox(Actual).DroppedDown then Msg.wParam := VK_RETURN; // el radiobutton if Actual is TRadioButton then Msg.wParam := VK_RETURN; // en el grid if Actual is TDBGrid then if (TDBGrid(Actual).ReadOnly) or (HiWord(GetKeyState(VK_CONTROL)) = 1)then Msg.wParam := VK_RETURN; // o esto otro Con Ctrl + intro siguiente celda con // ctrl + shift + intro celda anterior // es complicado pero es por no liar con el intro solo // que siempre pasa de un control a otro. if Actual is TDBGrid then begin if (TDBGrid(Actual).ReadOnly) or (HiWord(GetKeyState(VK_CONTROL)) = 0) then Msg.wParam := VK_RETURN else if not(HiWord(GetKeyState(VK_SHIFT)) = 0) then begin if TDBGrid(Actual).selectedindex > 0 then { increment the field } TDBGrid(Actual).selectedindex := TDBGrid(Actual).selectedindex -1 else TDBGrid(Actual).selectedindex := TDBGrid(Actual).fieldcount -1; end else begin if TDBGrid(Actual).selectedindex < (TDBGrid(Actual).fieldcount -1) then { increment the field } TDBGrid(Actual).selectedindex := TDBGrid(Actual).selectedindex +1 else TDBGrid(Actual).selectedindex := 0; end; end; // ListBox if Actual is TCustomListBox then Msg.wParam := VK_RETURN; // TabControl if Actual is TCustomTabControl then Msg.wParam := VK_RETURN; // Aqui se pondrían todos los controles que usamos en la // aplicación y necesitamos cambiar el tab por intro. // de esta forma te despreocupas de cuantos añades y es más // limpio el código end; end; end; procedure TFMENU.AOPCIONESExecute(Sender: TObject); begin if not Hija(TOPCIONESNUMERICAS) then TOPCIONESNUMERICAS.Create(self); end; procedure TFMENU.Button1Click(Sender: TObject); VAR AUX,I:INTEGER; A,B:STRING; begin DMGS.CDSQ_PROCEDURE.Close; DMGS.CDSQ_PROCEDURE.COMMANDTEXT := ' SELECT MAX(PROFUNDIDAD) FROM FAMILIAS'; DMGS.CDSQ_PROCEDURE.OPEN; AUX := DMGS.CDSQ_PROCEDURE.FIELDS[0].ASINTEGER; FOR I:=1 TO AUX DO BEGIN WITH DMGS.CDSQ_FAMILIASAUX DO BEGIN CLOSE; DMGS.VFAMILIASAUX.ID:=' WHERE PROFUNDIDAD='+INTTOSTR(I); DMGS.VFAMILIASAUX.TIPO := '4'; DMGS.VFAMILIASAUX.ORDEN :=' ORDER BY PROFUNDIDAD '; OPEN; WHILE NOT EOF DO BEGIN LAST; IF EOF THEN try // para evitar el error de memoria bloqueada en el server. GetNextPacket; except end; END; FIRST; WHILE NOT Eof DO BEGIN EDIT; DMGS.RFAMILIASAUX.PREGUNTA := FALSE; A:= COPY(DMGS.CDSQ_FAMILIASAUXCOD_FAMILIA.AsString,1,LENGTH(DMGS.CDSQ_FAMILIASAUXCOD_FAMILIA.ASSTRING) - LENGTH(DMGS.CDSQ_FAMILIASAUXID_FAMILIA.ASSTRING)); DMGS.CDSQ_FAMILIASAUXPADRE.AsString := A; DMGS.CDSQ_FAMILIASAUX.ApplyUpdates (0); NEXT; END; CLOSE; END; END; { DMGS.CDSQ_FAMILIAS.OPEN; BUTTON1.Enabled := FALSE; BUTTON1.Visible := FALSE; } end; procedure TFMENU.ToolButton23Click(Sender: TObject); VAR CADENA:STRING; begin LISTADOOPCIONESARTICULOS := tlistadoopcionesARTICULOS.create(nil); if listadoopcionesARTICULOS.ShowModal = mrok then begin IF (TRIM(LISTADOOPCIONESARTICULOS.CALBARANES) <> '') OR (TRIM(LISTADOOPCIONESARTICULOS.CTICKETS) <> '') OR (TRIM(LISTADOOPCIONESARTICULOS.CFACTURAS) <> '') THEN BEGIN LISTADOS := tLISTADOS.Create(nil); PREVIO := TPREVIO.Create(NIL); LISTADOS.FRDB.DataSet := DMGS.CDSQ_LARTICULOS; LISTADOS.FRDB2.DataSet := DMGS.CDSQ_EMPRESAAUX; LISTADOS.FRDB3.DataSet := DMGS.CDSQ_CLIENTEAUX; LISTADOS.FECHADESDE := LISTADOOPCIONESARTICULOS.MaskEdit1.Text ; LISTADOS.FECHAHASTA := LISTADOOPCIONESARTICULOS.MaskEdit2.Text ; IF TRIM(LISTADOOPCIONESARTICULOS.CALBARANES) <> '' THEN BEGIN DMGS.CDSQ_LARTICULOS.CLOSE; DMGS.VLARTICULOS.ID1 := ''; DMGS.VLARTICULOS.ID := LISTADOOPCIONESARTICULOS.CALBARANES; DMGS.VLARTICULOS.ORDEN := LISTADOOPCIONESARTICULOS.OALBARANES; DMGS.VLARTICULOS.GRUPO := LISTADOOPCIONESARTICULOS.GALBARANES; DMGS.VLARTICULOS.TIPO := '2'; DMGS.CDSQ_LARTICULOS.Open; WHILE not dmgs.cdsq_LARTICULOS.eof do begin dmgs.cdsq_LARTICULOS.Last; if dmgs.cdsq_LARTICULOS.Eof then try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_LARTICULOS.GetNextPacket ; except end; end; dmgs.cdsq_LARTICULOS.First; IF DMGS.CDSQ_LARTICULOS.RECORDCOUNT > 0 THEN WITH DMGS.CDSQ_EMPRESAAUX DO BEGIN Close; DMGS.VEMPRESASAUX.ID:= DMGS.CDSQ_LARTICULOS.FieldValues['ID_EMPRESA']; DMGS.VEMPRESASAUX.TIPO :='2'; OPEN; END; LISTADOS.ETIQUETA := ' EN ALBARANES '; IF LISTADOOPCIONESARTICULOS.DETALLE THEN LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOARTICULOSDETALLE.frf') ELSE LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOARTICULOSGRUPOS.frf'); LISTADOS.frReport1.Preview := PREVIO.frPreview1; LISTADOS.frReport1.ShowReport; PREVIO. ShowModal; END; IF TRIM(LISTADOOPCIONESARTICULOS.CFACTURAS) <> '' THEN BEGIN DMGS.CDSQ_LARTICULOS.CLOSE; DMGS.VLARTICULOS.ID1 := ''; DMGS.VLARTICULOS.ID := LISTADOOPCIONESARTICULOS.CFACTURAS; DMGS.VLARTICULOS.ORDEN := LISTADOOPCIONESARTICULOS.OFACTURAS; DMGS.VLARTICULOS.GRUPO := LISTADOOPCIONESARTICULOS.GFACTURAS; DMGS.VLARTICULOS.TIPO := '2'; DMGS.CDSQ_LARTICULOS.Open; WHILE not dmgs.cdsq_LARTICULOS.eof do begin dmgs.cdsq_LARTICULOS.Last; if dmgs.cdsq_LARTICULOS.Eof then try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_LARTICULOS.GetNextPacket ; except end; end; dmgs.cdsq_LARTICULOS.First; IF DMGS.CDSQ_LARTICULOS.RECORDCOUNT > 0 THEN WITH DMGS.CDSQ_EMPRESAAUX DO BEGIN Close; DMGS.VEMPRESASAUX.ID:= DMGS.CDSQ_LARTICULOS.FieldValues['ID_EMPRESA']; DMGS.VEMPRESASAUX.TIPO :='2'; OPEN; END; LISTADOS.ETIQUETA := ' EN FACTURAS '; IF LISTADOOPCIONESARTICULOS.DETALLE THEN LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOARTICULOSDETALLEFACTURAS.frf') ELSE LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOARTICULOSGRUPOSFACTURAS.frf'); LISTADOS.frReport1.Preview := PREVIO.frPreview1; LISTADOS.frReport1.ShowReport; PREVIO.ShowModal; END; IF TRIM(LISTADOOPCIONESARTICULOS.CTICKETS) <> '' THEN BEGIN DMGS.CDSQ_LARTICULOS.CLOSE; DMGS.VLARTICULOS.ID1 := ''; DMGS.VLARTICULOS.ID := LISTADOOPCIONESARTICULOS.CTICKETS; DMGS.VLARTICULOS.ORDEN := LISTADOOPCIONESARTICULOS.OTICKETS; DMGS.VLARTICULOS.GRUPO := LISTADOOPCIONESARTICULOS.GTICKETS; DMGS.VLARTICULOS.TIPO := '2'; DMGS.CDSQ_LARTICULOS.Open; WHILE not dmgs.cdsq_LARTICULOS.eof do begin dmgs.cdsq_LARTICULOS.Last; if dmgs.cdsq_LARTICULOS.Eof then try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_LARTICULOS.GetNextPacket ; except end; end; dmgs.cdsq_LARTICULOS.First; IF DMGS.CDSQ_LARTICULOS.RECORDCOUNT > 0 THEN WITH DMGS.CDSQ_EMPRESAAUX DO BEGIN Close; DMGS.VEMPRESASAUX.ID:= DMGS.CDSQ_LARTICULOS.FieldValues['ID_EMPRESA']; DMGS.VEMPRESASAUX.TIPO :='2'; OPEN; END; LISTADOS.ETIQUETA := ' EN TICKETS '; IF LISTADOOPCIONESARTICULOS.DETALLE THEN LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOARTICULOSDETALLE.frf') ELSE LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOARTICULOSGRUPOS.frf'); LISTADOS.frReport1.Preview := PREVIO.frPreview1; LISTADOS.frReport1.ShowReport; PREVIO.ShowModal; END; LISTADOS.Free; LISTADOS := NIL; PREVIO.FREE; PREVIO := NIL; DMGS.CDSQ_EMPRESAAUX.CLOSE; DMGS.CDSQ_CLIENTEAUX.CLOSE; DMGS.CDSQ_TICKETAUX.CLOSE; end; END; listadoopcionesARTICULOS.FREE; listadoopcionesARTICULOS := NIL; end; procedure TFMENU.Button2Click(Sender: TObject); VAR AUX,I:INTEGER; A,B,AUXA:STRING; begin with DMGS.CDSQ_MDFACTURA do BEGIN Close; DMGS.VFACTURA.ID := ' where id_ALBARAN<> 0 '+ ordenFACTURA ; DMGS.VFACTURA.TIPO := '2'; DMGS.VFACTURA.ORDENLINEA := ORDENLINEAFACTURA; Open; WHILE NOT DMGS.CDSQ_MDFACTURA.EOF DO BEGIN DMGS.CDSQ_MDFACTURA.LAST; IF DMGS.CDSQ_MDFACTURA.EOF THEN try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_MDFACTURA.GetNextPacket; except end; END; DMGS.CDSQ_MDFACTURA.First; WHILE NOT DMGS.CDSQ_MDFACTURA.EOF DO BEGIN IF DMGS.CDSQ_MDLINEAFACTURA.RecordCount > 0 THEN BEGIN DMGS.CDSQ_MDLINEAFACTURA.First; dmgs.TRANSACTIONACTUALIZAR :=10; WITH dmgs.CDSQ_ACTUALIZAR DO BEGIN commandtext := 'INSERT INTO FACTURASALBARANES (ID_FACTURA,ANYO,ID_EMPRESA,ID_SERIE,ID_ALBARAN,ALBANYO,ALBID_EMPRESA,ALBID_SERIE,BASE_FACTURA,BASE_ALBARAN,ALBTOTAL_COBRADO,TIPO) ' + ' VALUES('+DMGS.CDSQ_MDLINEAFACTURAID_FACTURA.ASSTRING+','+DMGS.CDSQ_MDLINEAFACTURAANYO.ASSTRING+','+DMGS.CDSQ_MDLINEAFACTURAID_EMPRESA.ASSTRING+','''+DMGS.CDSQ_MDLINEAFACTURAID_SERIE.ASSTRING+''','+DMGS.CDSQ_MDFACTURAID_ALBARAN.ASSTRING+','+DMGS.CDSQ_MDFACTURAANYO.ASSTRING+','+DMGS.CDSQ_MDFACTURAID_EMPRESA.ASSTRING+','''+DMGS.CDSQ_MDFACTURAID_SERIE.ASSTRING+''','+StringReplace(DMGS.CDSQ_MDFACTURAbase_factuRA.ASSTRING , ',', '.', [rfreplaceall])+',0,0,''AL'' )'; AUXA := COMMANDTEXT; try Execute; except showmessage('Error No se ha insertado en facturasalbaranes.'); dmgs.transactionACTUALIZAR:=-1; // CON ESTO HAGO QUE EL SERVER // HAGA UN ROLLBACK Y EJECUTO COMMIT, PARA QUE SEA // TODO VALIDO, PODRIA EJECUTAR UN ROLLBACK, PERO NO SE, NO ME FIO. COMMANDTEXT := 'COMMIT'; EXECUTE; end; END; WHILE NOT DMGS.CDSQ_MDLINEAFACTURA.Eof DO BEGIN DMGS.CDSQ_MDLINEAFACTURA.Edit; DMGS.CDSQ_MDLINEAFACTURANUMERO.Value := DMGS.CDSQ_MDFACTURAID_ALBARAN.Value ; DMGS.CDSQ_MDLINEAFACTURAALBID_SERIE.Value := DMGS.CDSQ_MDFACTURAID_SERIE.Value ; DMGS.CDSQ_MDLINEAFACTURAALBID_EMPRESA.Value := DMGS.CDSQ_MDFACTURAID_EMPRESA.Value ; DMGS.CDSQ_MDLINEAFACTURAALBANYO.Value := DMGS.CDSQ_MDFACTURAANYO.Value ; DMGS.RLINEAFACTURA.PREGUNTA := FALSE; DMGS.CDSQ_MDLINEAFACTURA.Post; DMGS.CDSQ_MDLINEAFACTURA.Next; END; DMGS.CDSQ_MDLINEAFACTURA.Next; END; DMGS.CDSQ_MDFACTURA.Next; END; CLOSE; END; end; procedure TFMENU.Button3Click(Sender: TObject); VAR AUX,I:INTEGER; A,B,AUXA,AUXS:STRING; CORRECTO :BOOLEAN; begin // PARA ALBARAN // with DMGS.CDSQ_MDALBARAN do BEGIN Close; DMGS.VALBARAN.ID :=' WHERE TOTAL_COBRADO<>0 ORDER BY ID_ALBARAN '; DMGS.VALBARAN.TIPO := '2'; dmgs.VALBARAN.ORDEN := ''; DMGS.VALBARAN.ORDENLINEA := ORDENLINEAALBARAN; Open; END; WHILE NOT DMGS.CDSQ_mDALBARAN.Eof DO BEGIN DMGS.CDSQ_MDALBARAN.LAST; IF DMGS.CDSQ_MDALBARAN.Eof THEN try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_MDALBARAN.GetNextPacket ; except end; END; DMGS.CDSQ_MDALBARAN.FIRST; WHILE NOT DMGS.CDSQ_mDALBARAN.Eof DO BEGIN IF (roundto(DMGS.CDSQ_MDALBARANdesctotal.asfloat,DMGS.decimales) <= roundto(DMGS.CDSQ_MDALBARANTOTAL_COBRADO.asfloat,DMGS.decimales)) and (roundto(DMGS.cdsq_mdALBARANtotal_cobrado.asfloat,DMGS.decimales) > 0 ) AND ( DMGS.CDSQ_MDALBARANFACTURADO.ASSTRING = '') THEN BEGIN DMGS.RALBARAN.PREGUNTA := FALSE; DMGS.CDSQ_MDALBARAN.EDIT; DMGS.CDSQ_MDALBARANCOBRADO.value := 1; DMGS.CDSQ_MDALBARAN.POST; END ELSE IF (DMGS.CDSQ_MDALBARANFACTURADO.ASSTRING <> '') THEN BEGIN WITH DMGS.CDSQ_FLOAT DO BEGIN CLOSE; COMMANDTEXT := ' SELECT ID_FACTURA,ANYO,ID_EMPRESA,ID_SERIE FROM FACTURASALBARANES WHERE ID_ALBARAN='+DMGS.CDSQ_MDALBARANID_ALBARAN.ASSTRING+' AND ALBID_EMPRESA= ' + DMGS.CDSQ_MDALBARANID_EMPRESA.AsString +' AND ALBANYO='+DMGS.CDSQ_MDALBARANANYO.AsString+' AND ALBID_SERIE='''+DMGS.CDSQ_MDALBARANID_SERIE.ASSTRING+''' AND TIPO=''AL'' '; OPEN; IF (RECORDCOUNT>0 ) THEN with DMGS.CDSQ_MDFACTURA do BEGIN Close; DMGS.VFACTURA.ID :=' WHERE ID_FACTURA='+DMGS.CDSQ_FLOAT.FIELDS[0].AsString+' AND ANYO='+DMGS.CDSQ_FLOAT.FIELDS[1].AsString+'AND ID_EMPRESA='+DMGS.CDSQ_FLOAT.FIELDS[2].AsString+' AND ID_SERIE='''+DMGS.CDSQ_FLOAT.FIELDS[3].AsString+''' '; DMGS.VFACTURA.TIPO := '2'; dmgs.VFACTURA.ORDEN := ordenFACTURA; DMGS.VFACTURA.ORDENLINEA := ORDENLINEAFACTURA; Open; DMGS.RFACTURA.PREGUNTA := FALSE ; DMGS.RFACTURA.PREGUNTAEDIT := FALSE; EDIT; DMGS.CDSQ_MDFACTURATOTAL_COBRADO.VALUE := DMGS.CDSQ_MDALBARANTOTAL_COBRADO.VALUE; POST; END; END; dmgs.TRANSACTIONACTUALIZAR :=10; WITH dmgs.CDSQ_ACTUALIZAR DO BEGIN commandtext := 'UPDATE ALBARANES SET TOTAL_COBRADO=0 WHERE ID_ALBARAN='+ DMGS.CDSQ_MDALBARANID_ALBARAN.ASSTRING +' AND ID_SERIE= '''+ DMGS.CDSQ_MDALBARANID_SERIE.ASSTRING +''' AND ID_EMPRESA='+ DMGS.CDSQ_MDALBARANID_EMPRESA.ASSTRING+ ' AND ANYO = '+DMGS.CDSQ_MDALBARANANYO.ASSTRING +' '; AUXS := COMMANDTEXT; try CORRECTO:=FALSE; Execute; CORRECTO := TRUE; except showmessage('Error No se ha insertado en facturasalbaranes.'); dmgs.transactionACTUALIZAR:=-1; // CON ESTO HAGO QUE EL SERVER // HAGA UN ROLLBACK Y EJECUTO COMMIT, PARA QUE SEA // TODO VALIDO, PODRIA EJECUTAR UN ROLLBACK, PERO NO SE, NO ME FIO. COMMANDTEXT := 'COMMIT'; EXECUTE; end; END; IF CORRECTO THEN BEGIN // CAMBIO EN COBRO EL TIPO EL ID EL ANYO Y EL ID_SERIE dmgs.TRANSACTIONACTUALIZAR :=10; WITH dmgs.CDSQ_ACTUALIZAR DO BEGIN commandtext := 'UPDATE COBRO SET TIPO=''FACTURA'',ID='+DMGS.CDSQ_MDFACTURAID_FACTURA.ASSTRING +',ID_SERIE='''+DMGS.CDSQ_MDFACTURAID_SERIE.ASSTRING+''',ANYOSERIE='+DMGS.CDSQ_MDFACTURAANYO.ASSTRING +' ' + ' WHERE TIPO =''ALBARAN'' AND ID='+ DMGS.CDSQ_MDALBARANID_ALBARAN.ASSTRING +' AND ID_SERIE= '''+ DMGS.CDSQ_MDALBARANID_SERIE.ASSTRING +''' AND ID_EMPRESA='+ DMGS.CDSQ_MDALBARANID_EMPRESA.ASSTRING+ ' AND ANYOSERIE = '+DMGS.CDSQ_MDALBARANANYO.ASSTRING +' '; AUXS := COMMANDTEXT; try CORRECTO:=FALSE; Execute; CORRECTO := TRUE; except showmessage('Error No se ha insertado en facturasalbaranes.'); dmgs.transactionACTUALIZAR:=-1; // CON ESTO HAGO QUE EL SERVER // HAGA UN ROLLBACK Y EJECUTO COMMIT, PARA QUE SEA // TODO VALIDO, PODRIA EJECUTAR UN ROLLBACK, PERO NO SE, NO ME FIO. COMMANDTEXT := 'COMMIT'; EXECUTE; end; END; END; CORRECTO := FALSE; END; DMGS.CDSQ_MDALBARAN.NEXT; END; DMGS.CDSQ_MDALBARAN.CLOSE; // PARA FACTURA // with DMGS.CDSQ_MDFACTURA do BEGIN Close; DMGS.VFACTURA.ID :=' WHERE TOTAL_COBRADO<>0 '; DMGS.VFACTURA.TIPO := '2'; dmgs.VFACTURA.ORDEN := ordenFACTURA; DMGS.VFACTURA.ORDENLINEA := ORDENLINEAFACTURA; Open; END; WHILE NOT DMGS.CDSQ_mDFACTURA.Eof DO BEGIN DMGS.CDSQ_MDFACTURA.LAST; IF DMGS.CDSQ_MDFACTURA.Eof THEN try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_MDFACTURA.GetNextPacket ; except end; END; DMGS.CDSQ_MDFACTURA.FIRST; WHILE NOT DMGS.CDSQ_mDFACTURA.Eof DO BEGIN IF (roundto(DMGS.CDSQ_MDFACTURAdesctotal.asfloat,DMGS.decimales) <= roundto(DMGS.CDSQ_MDFACTURATOTAL_COBRADO.asfloat,DMGS.decimales)) and (roundto(DMGS.cdsq_mdFACTURAtotal_cobrado.asfloat,DMGS.decimales) > 0 ) THEN BEGIN DMGS.RFACTURA.PREGUNTA := FALSE; DMGS.RFACTURA.PREGUNTAEDIT := FALSE; DMGS.CDSQ_MDFACTURA.EDIT; DMGS.CDSQ_MDFACTURACOBRADO.value := 1; DMGS.CDSQ_MDFACTURA.POST; END; DMGS.CDSQ_MDFACTURA.NEXT; END; DMGS.CDSQ_MDFACTURA.CLOSE; // PARA FACTURAS QUE VENGAN DE ALBARANES Y ESTEN COBRADAS // with DMGS.CDSQ_MDALBARAN do BEGIN Close; DMGS.VALBARAN.ID :=' WHERE TOTAL_COBRADO<>0 '; DMGS.VALBARAN.TIPO := '2'; dmgs.VALBARAN.ORDEN := ordenalbaran; DMGS.VALBARAN.ORDENLINEA := ORDENLINEAALBARAN; Open; END; WHILE NOT DMGS.CDSQ_mDALBARAN.Eof DO BEGIN DMGS.CDSQ_MDALBARAN.LAST; IF DMGS.CDSQ_MDALBARAN.Eof THEN try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_MDALBARAN.GetNextPacket ; except end; END; DMGS.CDSQ_MDALBARAN.FIRST; WHILE NOT DMGS.CDSQ_mDALBARAN.Eof DO BEGIN WITH DMGS.CDSQ_FLOAT DO BEGIN CLOSE; COMMANDTEXT := ' SELECT ID_FACTURA,ANYO,ID_EMPRESA,ID_SERIE FROM FACTURASALBARANES WHERE ID_ALBARAN='+DMGS.CDSQ_MDALBARANID_ALBARAN.ASSTRING+' AND ALBID_EMPRESA= ' + DMGS.CDSQ_MDALBARANID_EMPRESA.AsString +' AND ALBANYO='+DMGS.CDSQ_MDALBARANANYO.AsString+' AND ALBID_SERIE='''+DMGS.CDSQ_MDALBARANID_SERIE.ASSTRING+''' AND TIPO=''AL'' '; OPEN; IF (RECORDCOUNT>0 ) AND (DMGS.CDSQ_MDALBARANCOBRADO.Value = 1) THEN with DMGS.CDSQ_MDFACTURA do BEGIN Close; DMGS.VFACTURA.ID :=' WHERE ID_FACTURA='+DMGS.CDSQ_FLOAT.FIELDS[0].AsString+' AND ANYO='+DMGS.CDSQ_FLOAT.FIELDS[1].AsString+'AND ID_EMPRESA='+DMGS.CDSQ_FLOAT.FIELDS[2].AsString+' AND ID_SERIE='''+DMGS.CDSQ_FLOAT.FIELDS[3].AsString+''' '; DMGS.VFACTURA.TIPO := '2'; dmgs.VFACTURA.ORDEN := ordenFACTURA; DMGS.VFACTURA.ORDENLINEA := ORDENLINEAFACTURA; Open; DMGS.RFACTURA.PREGUNTA := FALSE ; DMGS.RFACTURA.PREGUNTAEDIT := FALSE ; EDIT; DMGS.CDSQ_MDFACTURACOBRADO.Value := 2; POST; END; END; DMGS.CDSQ_MDALBARAN.NEXT; END; DMGS.CDSQ_MDALBARAN.Close; DMGS.CDSQ_MDFACTURA.CLOSE; END; procedure TFMENU.aarqueodecajaExecute(Sender: TObject); begin ARQUEODECAJA:=tARQUEODECAJA.create(nil); ARQUEODECAJA.Showmodal; ARQUEODECAJA.Free; ARQUEODECAJA := nil; end; procedure TFMENU.ArticulosVendidos1Click(Sender: TObject); VAR CADENA:STRING; begin LISTADOOPCIONESARTICULOS := tlistadoopcionesARTICULOS.create(nil); if listadoopcionesARTICULOS.ShowModal = mrok then begin IF (TRIM(LISTADOOPCIONESARTICULOS.CALBARANES) <> '') OR (TRIM(LISTADOOPCIONESARTICULOS.CTICKETS) <> '') OR (TRIM(LISTADOOPCIONESARTICULOS.CFACTURAS) <> '') THEN BEGIN LISTADOS := tLISTADOS.Create(nil); PREVIO := TPREVIO.Create(NIL); LISTADOS.FRDB.DataSet := DMGS.CDSQ_LARTICULOS; LISTADOS.FRDB2.DataSet := DMGS.CDSQ_EMPRESAAUX; LISTADOS.FRDB3.DataSet := DMGS.CDSQ_CLIENTEAUX; LISTADOS.FECHADESDE := LISTADOOPCIONESARTICULOS.MaskEdit1.Text ; LISTADOS.FECHAHASTA := LISTADOOPCIONESARTICULOS.MaskEdit2.Text ; IF TRIM(LISTADOOPCIONESARTICULOS.CALBARANES) <> '' THEN BEGIN DMGS.CDSQ_LARTICULOS.CLOSE; DMGS.VLARTICULOS.ID1 := ''; DMGS.VLARTICULOS.ID := LISTADOOPCIONESARTICULOS.CALBARANES; DMGS.VLARTICULOS.ORDEN := LISTADOOPCIONESARTICULOS.OALBARANES; DMGS.VLARTICULOS.GRUPO := LISTADOOPCIONESARTICULOS.GALBARANES; DMGS.VLARTICULOS.TIPO := '2'; DMGS.CDSQ_LARTICULOS.Open; WHILE not dmgs.cdsq_LARTICULOS.eof do begin dmgs.cdsq_LARTICULOS.Last; if dmgs.cdsq_LARTICULOS.Eof then try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_LARTICULOS.GetNextPacket ; except end; end; dmgs.cdsq_LARTICULOS.First; IF DMGS.CDSQ_LARTICULOS.RECORDCOUNT > 0 THEN WITH DMGS.CDSQ_EMPRESAAUX DO BEGIN Close; DMGS.VEMPRESASAUX.ID:= DMGS.CDSQ_LARTICULOS.FieldValues['ID_EMPRESA']; DMGS.VEMPRESASAUX.TIPO :='2'; OPEN; END; LISTADOS.ETIQUETA := ' EN ALBARANES '; IF LISTADOOPCIONESARTICULOS.DETALLE THEN LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOARTICULOSDETALLE.frf') ELSE LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOARTICULOSGRUPOS.frf'); LISTADOS.frReport1.Preview := PREVIO.frPreview1; LISTADOS.frReport1.ShowReport; PREVIO.ShowModal; END; IF TRIM(LISTADOOPCIONESARTICULOS.CFACTURAS) <> '' THEN BEGIN DMGS.CDSQ_LARTICULOS.CLOSE; DMGS.VLARTICULOS.ID1 := ''; DMGS.VLARTICULOS.ID := LISTADOOPCIONESARTICULOS.CFACTURAS; DMGS.VLARTICULOS.ORDEN := LISTADOOPCIONESARTICULOS.OFACTURAS; DMGS.VLARTICULOS.GRUPO := LISTADOOPCIONESARTICULOS.GFACTURAS; DMGS.VLARTICULOS.TIPO := '2'; DMGS.CDSQ_LARTICULOS.Open; WHILE not dmgs.cdsq_LARTICULOS.eof do begin dmgs.cdsq_LARTICULOS.Last; if dmgs.cdsq_LARTICULOS.Eof then try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_LARTICULOS.GetNextPacket ; except end; end; dmgs.cdsq_LARTICULOS.First; IF DMGS.CDSQ_LARTICULOS.RECORDCOUNT > 0 THEN WITH DMGS.CDSQ_EMPRESAAUX DO BEGIN Close; DMGS.VEMPRESASAUX.ID:= DMGS.CDSQ_LARTICULOS.FieldValues['ID_EMPRESA']; DMGS.VEMPRESASAUX.TIPO :='2'; OPEN; END; LISTADOS.ETIQUETA := ' EN FACTURAS '; IF LISTADOOPCIONESARTICULOS.DETALLE THEN LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOARTICULOSDETALLEFACTURAS.frf') ELSE LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOARTICULOSGRUPOSFACTURAS.frf'); LISTADOS.frReport1.Preview := PREVIO.frPreview1; LISTADOS.frReport1.ShowReport; PREVIO.ShowModal; END; IF TRIM(LISTADOOPCIONESARTICULOS.CTICKETS) <> '' THEN BEGIN DMGS.CDSQ_LARTICULOS.CLOSE; DMGS.VLARTICULOS.ID1 := ''; DMGS.VLARTICULOS.ID := LISTADOOPCIONESARTICULOS.CTICKETS; DMGS.VLARTICULOS.ORDEN := LISTADOOPCIONESARTICULOS.OTICKETS; DMGS.VLARTICULOS.GRUPO := LISTADOOPCIONESARTICULOS.GTICKETS; DMGS.VLARTICULOS.TIPO := '2'; DMGS.CDSQ_LARTICULOS.Open; WHILE not dmgs.cdsq_LARTICULOS.eof do begin dmgs.cdsq_LARTICULOS.Last; if dmgs.cdsq_LARTICULOS.Eof then try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_LARTICULOS.GetNextPacket ; except end; end; dmgs.cdsq_LARTICULOS.First; IF DMGS.CDSQ_LARTICULOS.RECORDCOUNT > 0 THEN WITH DMGS.CDSQ_EMPRESAAUX DO BEGIN Close; DMGS.VEMPRESASAUX.ID:= DMGS.CDSQ_LARTICULOS.FieldValues['ID_EMPRESA']; DMGS.VEMPRESASAUX.TIPO :='2'; OPEN; END; LISTADOS.ETIQUETA := ' EN TICKETS '; IF LISTADOOPCIONESARTICULOS.DETALLE THEN LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOARTICULOSDETALLE.frf') ELSE LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOARTICULOSGRUPOS.frf'); LISTADOS.frReport1.Preview := PREVIO.frPreview1; LISTADOS.frReport1.ShowReport; PREVIO.ShowModal; END; LISTADOS.Free; LISTADOS := NIL; PREVIO.FREE; PREVIO := NIL; DMGS.CDSQ_EMPRESAAUX.CLOSE; DMGS.CDSQ_CLIENTEAUX.CLOSE; DMGS.CDSQ_TICKETAUX.CLOSE; end; END; listadoopcionesARTICULOS.FREE; listadoopcionesARTICULOS := NIL; end; procedure TFMENU.Cobros1Click(Sender: TObject); var cadena,CADENAAUX:string; begin listadoopcionescobro := tlistadoopcionescobro.create(nil); if listadoopcionescobro.ShowModal = mrok then begin cadena := listadoopcionescobro.cadena; if trim(cadena) <> '' then begin if (listadoopcionescobro.todo = false) then if (listadoopcionescobro.cobrado = true) then cadena := cadena + ' and total_cobrado >= base and total_cobrado <> 0 ' else cadena := cadena + ' and total_cobrado <= base '; end else begin if (listadoopcionescobro.todo = false) then if (listadoopcionescobro.cobrado = true) then cadena := cadena + ' total_cobrado >= base and total_cobrado <> 0 ' else cadena := cadena + ' total_cobrado <= base '; end; if trim(cadena) <> '' then begin CADENAAUX := CADENA; // cadena := ' id_empresa='+fmenu.id_empresa+' and ' + cadena; // cadena := ' AND ' + cadena +' ORDER BY ID_cobro '; end; listadoopcionescobro.free; listadoopcionescobro := nil; WITH DMGS.CDSQ_EMPRESAAUX DO BEGIN Close; DMGS.VEMPRESASAUX.ID:= DMGS.CDSQ_MDcobroID_EMPRESA.AsString; DMGS.VEMPRESASAUX.TIPO :='2'; OPEN; END; with DMGS.CDSQ_MDcobroaux do BEGIN Close; if trim(cadena) ='' then begin // DMGS.VCOBROAUX.ID :='%'; DMGS.VCOBROAUX.TIPO := '3'; DMGS.VCOBROAUX.ORDEN := ORDENCOBROAUX; end else begin DMGS.VCOBROAUX.ID :=' AND '+cadenaAUX; DMGS.VCOBROAUX.TIPO := '3'; DMGS.VCOBROAUX.ORDEN := ORDENCOBROAUX; end; Open; END; WHILE not dmgs.cdsq_mdcobroaux.eof do begin dmgs.cdsq_mdcobroaux.Last; if dmgs.cdsq_mdcobroaux.Eof then try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_MDcobroaux.GetNextPacket ; except end; end; dmgs.cdsq_mdcobroaux.First; LISTADOS := tLISTADOS.Create(nil); PREVIO := TPREVIO.Create(NIL); LISTADOS.FRDB.DataSet := DMGS.CDSQ_MDcobroaux; LISTADOS.FRDB1.DATASET := DMGS.CDSQ_MDLINEAcobroaux; LISTADOS.FRDB2.DataSet := DMGS.CDSQ_EMPRESAAUX; LISTADOS.FRDB3.DataSet := DMGS.CDSQ_CLIENTEAUX; // Path := ExtractFilePath(ParamStr(0)); LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOcobroS.frf'); LISTADOS.frReport1.Preview := PREVIO.frPreview1; LISTADOS.frReport1.ShowReport; PREVIO.ShowModal; LISTADOS.Free; LISTADOS := NIL; PREVIO.FREE; PREVIO := NIL; DMGS.CDSQ_EMPRESAAUX.CLOSE; DMGS.CDSQ_CLIENTEAUX.CLOSE; end; end; procedure TFMENU.Albaranes1Click(Sender: TObject); var cadena:string; BOOKMARK:TBOOKMARK; begin BOOKMARK:=DMGS.CDSQ_MDLINEAALBARAN.GetBookmark ; listadoopciones := tlistadoopciones.create(nil); listadoopciones.opcion := 1; if listadoopciones.ShowModal = mrok then begin cadena := listadoopciones.cadena; if trim(cadena) <> '' then begin if (listadoopciones.todo = false) then if (listadoopciones.cobrado = true) then // cadena := cadena + ' and total_cobrado >= base_albaran and total_cobrado <> 0 ' cadena := cadena + ' and cobrado =1 ' else if (listadoopciones.CONFACTURA = true) then cadena := cadena + ' and cobrado = 2 ' else // cadena := cadena + ' and total_cobrado <= base_ALBARAN '; cadena := cadena + ' and COBRADO = 0'; end else begin if (listadoopciones.todo = false) then if (listadoopciones.cobrado = true) then // cadena := cadena + ' total_cobrado >= base_ALBARAN and total_cobrado <> 0 ' cadena := cadena + ' COBRADO=1 ' else if (listadoopciones.confactura = true) then cadena := cadena + ' cobrado=2 ' else // cadena := cadena + ' total_cobrado <= base_ALBARAN '; cadena := cadena + ' COBRADO = 0 '; end; if trim(cadena) <> '' then begin CADENA := ' AND ' + CADENA; // cadena := ' id_empresa='+fmenu.id_empresa+' and '+ cadena; // cadena := ' AND '+ cadena +' ORDER BY FECHA,ID_ALBARAN '; end; listadoopciones.free; listadoopciones := nil; WITH DMGS.CDSQ_EMPRESAAUX DO BEGIN Close; DMGS.VEMPRESASAUX.ID:= DMGS.CDSQ_MDALBARANID_EMPRESA.AsString; DMGS.VEMPRESASAUX.TIPO :='2'; OPEN; END; with DMGS.CDSQ_MDALBARANaux do BEGIN Close; if trim(cadena) ='' then begin DMGS.VALBARANAUX.ID :='%'; DMGS.VALBARANAUX.TIPO := '1'; DMGS.VALBARANAUX.ORDEN := ORDENALBARAN; DMGS.VALBARANAUX.ORDENLINEA := ORDENLINEAALBARAN; end else begin DMGS.VALBARANAUX.ID :=cadena; DMGS.VALBARANAUX.TIPO := '3'; DMGS.VALBARANAUX.ORDENLINEA := ORDENLINEAALBARAN; DMGS.VALBARANAUX.ORDEN := ORDENALBARAN; end; Open; END; WHILE not dmgs.cdsq_mdALBARANaux.eof do begin dmgs.cdsq_mdALBARANaux.Last; if dmgs.cdsq_mdALBARANaux.Eof then try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_MDALBARANaux.GetNextPacket ; except end; end; dmgs.cdsq_mdALBARANaux.First; LISTADOS := tLISTADOS.Create(nil); PREVIO := TPREVIO.Create(NIL); LISTADOS.FRDB.DataSet := DMGS.CDSQ_MDALBARANaux; LISTADOS.FRDB1.DATASET := DMGS.CDSQ_MDLINEAALBARANaux; LISTADOS.FRDB2.DataSet := DMGS.CDSQ_EMPRESAAUX; LISTADOS.FRDB3.DataSet := DMGS.CDSQ_CLIENTEAUX; // Path := ExtractFilePath(ParamStr(0)); LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOALBARANes.frf'); LISTADOS.frReport1.Preview := PREVIO.frPreview1; LISTADOS.frReport1.ShowReport; PREVIO.ShowModal; LISTADOS.Free; LISTADOS := NIL; PREVIO.FREE; PREVIO := NIL; DMGS.CDSQ_EMPRESAAUX.CLOSE; DMGS.CDSQ_CLIENTEAUX.CLOSE; end; DMGS.CDSQ_MDLINEAALBARAN.GotoBookmark (BOOKMARK); DMGS.CDSQ_MDLINEAALBARAN.FreeBookmark(BOOKMARK); end; procedure TFMENU.Facturas1Click(Sender: TObject); var cadena:string; BOOKMARK:TBOOKMARK; begin BOOKMARK := DMGS.CDSQ_MDLINEAFACTURA.GetBookmark ; listadoopciones := tlistadoopciones.create(nil); listadoopciones.opcion := 1;//cliente if listadoopciones.ShowModal = mrok then begin cadena := listadoopciones.cadena; if trim(cadena) <> '' then begin if (listadoopciones.todo = false) then if (listadoopciones.cobrado = true) then // cadena := cadena + ' and total_cobrado >= base_factura and total_cobrado <> 0 ' cadena := cadena + ' and cobrado=1 ' else if (listadoopciones.CONFACTURA = true) then cadena := cadena + ' and cobrado = 2 ' else // cadena := cadena + ' and total_cobrado <= base_factura '; cadena := cadena + ' and cobrado=0 '; end else begin if (listadoopciones.todo = false) then if (listadoopciones.cobrado = true) then // cadena := cadena + ' total_cobrado >= base_factura and total_cobrado <> 0 ' cadena := cadena + ' cobrado=1 ' else if (listadoopciones.confactura = true) then cadena := cadena + ' cobrado=2 ' else // cadena := cadena + ' total_cobrado <= base_factura '; cadena := cadena + ' cobrado=0 '; end; if trim(cadena) <> '' then begin CADENA := ' AND ' + CADENA; // cadena := ' id_empresa='+fmenu.id_empresa+' and ' + cadena; // cadena := ' where '+ cadena +' ORDER BY FECHA,ID_FACTURA '; // cadena := ' AND ' + cadena +' ORDER BY FECHA,ID_FACTURA '; end; listadoopciones.free; listadoopciones := nil; WITH DMGS.CDSQ_EMPRESAAUX DO BEGIN Close; DMGS.VEMPRESASAUX.ID:= DMGS.CDSQ_MDFACTURAID_EMPRESA.AsString; DMGS.VEMPRESASAUX.TIPO :='2'; OPEN; END; with DMGS.CDSQ_MDFACTURAaux do BEGIN Close; if trim(cadena) ='' then begin DMGS.VFACTURAAUX.ID :='%'; DMGS.VFACTURAAUX.TIPO := '1'; DMGS.VFACTURAAUX.ORDEN := ORDENFACTURA; DMGS.VFACTURAAUX.ORDENLINEA := ORDENLINEAFACTURA; end else begin DMGS.VFACTURAAUX.ID :=cadena; DMGS.VFACTURAAUX.TIPO := '3'; DMGS.VFACTURAAUX.ORDENLINEA:= ORDENLINEAFACTURA; DMGS.VFACTURAAUX.ORDEN:= ORDENFACTURA; end; Open; END; WHILE not dmgs.cdsq_mdfacturaaux.eof do begin dmgs.cdsq_mdfacturaaux.Last; if dmgs.cdsq_mdfacturaaux.Eof then try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_MDFACTURAaux.GetNextPacket ; except end; end; dmgs.cdsq_mdfacturaaux.First; LISTADOS := tLISTADOS.Create(nil); PREVIO := TPREVIO.Create(NIL); LISTADOS.FRDB.DataSet := DMGS.CDSQ_MDfacturaaux; LISTADOS.FRDB1.DATASET := DMGS.CDSQ_MDLINEAfacturaaux; LISTADOS.FRDB2.DataSet := DMGS.CDSQ_EMPRESAAUX; LISTADOS.FRDB3.DataSet := DMGS.CDSQ_CLIENTEAUX; // Path := ExtractFilePath(ParamStr(0)); LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOFACTURAS.frf'); LISTADOS.frReport1.Preview := PREVIO.frPreview1; LISTADOS.frReport1.ShowReport; PREVIO.ShowModal; LISTADOS.Free; LISTADOS := NIL; PREVIO.FREE; PREVIO := NIL; DMGS.CDSQ_EMPRESAAUX.CLOSE; DMGS.CDSQ_CLIENTEAUX.CLOSE; end; DMGS.CDSQ_MDLINEAFACTURA.GotoBookmark(BOOKMARK); DMGS.CDSQ_MDLINEAFACTURA.FreeBookmark (BOOKMARK); end; procedure TFMENU.EntradasTotal1Click(Sender: TObject); var cadena:string; LISTADO:SMALLINT; FECHADESDE,FECHAHASTA:STRING; begin LISTADO := 0; listadoopciones := tlistadoopciones.create(nil); listadoopciones.opcion := 2;//ENTRADA if listadoopciones.ShowModal = mrok then begin cadena := listadoopciones.cadena; if trim(cadena) <> '' then begin if listadoopciones.DETALLE then listado := 1; if listadoopciones.total then listado := 2; if trim(cadena) <> '' then begin // CADENA := ' AND ' + CADENA; // cadena := ' id_empresa='+fmenu.id_empresa+' and ' + cadena; // en listado opciones se puede poner el orden. // cadena := ' where '+ cadena +' ORDER BY FECHA '; cadena := ' where '+ CADENA; FECHADESDE := DATETOSTR(LISTADOOPCIONES.FECHAINICIO); FECHAHASTA := DATETOSTR(LISTADOOPCIONES.FECHAFINAL); end; listadoopciones.free; listadoopciones := nil; WITH DMGS.CDSQ_EMPRESAAUX DO BEGIN Close; DMGS.VEMPRESASAUX.ID:= FMENU.ID_EMPRESA; DMGS.VEMPRESASAUX.TIPO :='2'; OPEN; END; LISTADOS := tLISTADOS.Create(nil); PREVIO := TPREVIO.Create(NIL); IF LISTADO=1 THEN BEGIN WITH DMGS.CDSQ_LISTADOENTRADA DO BEGIN CLOSE; DMGS.VLISTADOENTRADA.ID := CADENA; DMGS.VLISTADOENTRADA.TIPO := '1'; DMGS.VLISTADOENTRADA.ORDEN := ORDENLISTADOENTRADA; OPEN; END; WHILE not dmgs.CDSQ_LISTADOENTRADA.eof do begin dmgs.cdsq_LISTADOENTRADA.Last; if dmgs.cdsq_LISTADOENTRADA.Eof then try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_LISTADOENTRADA.GetNextPacket ; except end; end; dmgs.cdsq_LISTADOENTRADA.First; END ELSE IF LISTADO=2 THEN BEGIN WITH DMGS.CDSQ_LENTRADATOTAL DO BEGIN CLOSE; DMGS.VLENTRADATOTAL.ID := CADENA; DMGS.VLENTRADATOTAL.TIPO := '1'; OPEN; END; WHILE not DMGS.CDSQ_LENTRADATOTAL.eof do begin DMGS.CDSQ_LENTRADATOTAL.Last; if DMGS.CDSQ_LENTRADATOTAL.Eof then try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_LENTRADATOTAL.GetNextPacket ; except end; end; DMGS.CDSQ_LENTRADATOTAL.First; END; LISTADOS.FECHADESDE := FECHADESDE; LISTADOS.FECHAHASTA := FECHAHASTA; IF LISTADO=1 THEN BEGIN LISTADOS.FRDB.DataSet := DMGS.CDSQ_LISTADOENTRADA; LISTADOS.FRDB2.DataSet := DMGS.CDSQ_EMPRESAAUX; LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOENTRADADETALLE.frf'); END; IF LISTADO=2 THEN BEGIN LISTADOS.FRDB.DataSet := DMGS.CDSQ_LENTRADATOTAL; LISTADOS.FRDB2.DataSet := DMGS.CDSQ_EMPRESAAUX; LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOENTRADATOTAL.frf'); END; LISTADOS.frReport1.Preview := PREVIO.frPreview1; LISTADOS.frReport1.ShowReport; PREVIO.ShowModal; LISTADOS.Free; LISTADOS := NIL; PREVIO.FREE; PREVIO := NIL; DMGS.CDSQ_EMPRESAAUX.CLOSE; DMGS.CDSQ_CLIENTEAUX.CLOSE; end; END; end; procedure TFMENU.EntradasArticulos1Click(Sender: TObject); VAR CADENA:STRING; begin LISTADOENTRADAS := tLISTADOENTRADAS.create(nil); if LISTADOENTRADAS.ShowModal = mrok then begin IF (TRIM(LISTADOENTRADAS.CENTRADAS) <> '') THEN BEGIN LISTADOS := tLISTADOS.Create(nil); PREVIO := TPREVIO.Create(NIL); LISTADOS.FRDB.DataSet := DMGS.CDSQ_LARTICULOS; LISTADOS.FRDB2.DataSet := DMGS.CDSQ_EMPRESAAUX; LISTADOS.FRDB3.DataSet := DMGS.CDSQ_CLIENTEAUX; LISTADOS.FECHADESDE := LISTADOENTRADAS.MaskEdit1.Text ; LISTADOS.FECHAHASTA := LISTADOENTRADAS.MaskEdit2.Text ; IF TRIM(LISTADOENTRADAS.CENTRADAS) <> '' THEN BEGIN DMGS.CDSQ_LARTICULOS.CLOSE; DMGS.VLARTICULOS.ID1 := ''; DMGS.VLARTICULOS.ID := LISTADOENTRADAS.CENTRADAS; DMGS.VLARTICULOS.ORDEN := LISTADOENTRADAS.OENTRADAS; DMGS.VLARTICULOS.GRUPO := LISTADOENTRADAS.GENTRADAS; DMGS.VLARTICULOS.TIPO := '2'; DMGS.CDSQ_LARTICULOS.Open; WHILE not dmgs.cdsq_LARTICULOS.eof do begin dmgs.cdsq_LARTICULOS.Last; if dmgs.cdsq_LARTICULOS.Eof then try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_LARTICULOS.GetNextPacket ; except end; end; dmgs.cdsq_LARTICULOS.First; IF DMGS.CDSQ_LARTICULOS.RECORDCOUNT > 0 THEN WITH DMGS.CDSQ_EMPRESAAUX DO BEGIN Close; DMGS.VEMPRESASAUX.ID:= DMGS.CDSQ_LARTICULOS.FieldValues['ID_EMPRESA']; DMGS.VEMPRESASAUX.TIPO :='2'; OPEN; END; LISTADOS.ETIQUETA := ' EN ENTRADAS '; IF LISTADOENTRADAS.DETALLE THEN LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOENTRADADETALLE.frf') ELSE LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOENTRADAGRUPOS.frf'); LISTADOS.frReport1.Preview := PREVIO.frPreview1; LISTADOS.frReport1.ShowReport; PREVIO.ShowModal; END; LISTADOS.Free; LISTADOS := NIL; PREVIO.FREE; PREVIO := NIL; DMGS.CDSQ_EMPRESAAUX.CLOSE; DMGS.CDSQ_CLIENTEAUX.CLOSE; DMGS.CDSQ_TICKETAUX.CLOSE; end; END; LISTADOENTRADAS.FREE; LISTADOENTRADAS := NIL; end; procedure TFMENU.Almacen1Click(Sender: TObject); var cadena:string; TODAS:BOOLEAN; BOOKMARK:TBOOKMARK; begin TODAS:= FALSE; LISTADOOPCIONESALMACEN := tLISTADOOPCIONESALMACEN.create(nil); if LISTADOOPCIONESALMACEN.ShowModal = mrok then begin cadena := LISTADOOPCIONESALMACEN.cadena; if trim(cadena) <> '' then begin if (LISTADOOPCIONESALMACEN.todo = false) then if (LISTADOOPCIONESALMACEN.ENSTOCK = true) then cadena := cadena + ' and CANTIDAD > AVISAR ' else cadena := cadena + ' and CANTIDAD <= AVISAR '; end else begin if (LISTADOOPCIONESALMACEN.todo = false) then if (LISTADOOPCIONESALMACEN.ENSTOCK = true) then cadena := cadena + ' CANTIDAD > AVISAR ' else cadena := cadena + ' CANTIDAD <= AVISAR '; end; if trim(cadena) <> '' then begin IF NOT LISTADOOPCIONESALMACEN.TODAS THEN cadena := ' id_empresa='+fmenu.id_empresa+' and ' + cadena; cadena := ' where '+ cadena ; end; TODAS := LISTADOOPCIONESALMACEN.TODAS; LISTADOOPCIONESALMACEN.free; LISTADOOPCIONESALMACEN := nil; // dsALMACEN.DataSet := NIL; // HACE FALTA WITH DMGS.CDSQ_EMPRESAAUX DO BEGIN Close; DMGS.VEMPRESASAUX.ID:= DMGS.CDSQ_ALMACENAUXID_EMPRESA.AsString; DMGS.VEMPRESASAUX.TIPO :='2'; OPEN; END; with DMGS.CDSQ_ALMACENaux do BEGIN Close; if (trim(cadena) ='') AND ( NOT TODAS) then begin DMGS.almABGRID := '%'; dmgs.almAbgrtipo := '1'; DMGS.almABGRorden:= ORDENALMACEN end else begin dmgs.almAbgrtipo := '2'; DMGS.almABGRorden:= ORDENALMACEN; DMGS.almABGRID :=CADENA + DMGS.valmacen.ORDEN ; end; Open; END; WHILE not dmgs.cdsq_ALMACENaux.eof do begin dmgs.cdsq_ALMACENaux.Last; if dmgs.cdsq_ALMACENaux.Eof then try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_ALMACENaux.GetNextPacket ; except end; end; dmgs.cdsq_ALMACENaux.First; LISTADOS := tLISTADOS.Create(nil); PREVIO := TPREVIO.Create(NIL); LISTADOS.FRDB.DataSet := DMGS.CDSQ_ALMACENaux; LISTADOS.FRDB1.DataSet := DMGS.CDSQ_EMPRESAAUX; // Path := ExtractFilePath(ParamStr(0)); LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOALMACEN.frf'); LISTADOS.frReport1.Preview := PREVIO.frPreview1; LISTADOS.frReport1.ShowReport; PREVIO.ShowModal; // DSALMACEN.DataSet := DMGS.CDSQ_ALMACENAUX; LISTADOS.Free; LISTADOS := NIL; PREVIO.FREE; PREVIO := NIL; DMGS.CDSQ_EMPRESAAUX.CLOSE; end; end; procedure TFMENU.Avisos1Click(Sender: TObject); var cadena:string; BOOKMARK:TBOOKMARK; begin listadoopcionesTICKET := tlistadoopcionesTICKET.create(nil); if listadoopcionesTICKET.ShowModal = mrok then begin cadena := listadoopcionesTICKET.cadena; listadoopciones.free; listadoopciones := nil; WITH DMGS.CDSQ_EMPRESAAUX DO BEGIN Close; DMGS.VEMPRESASAUX.ID:= DMGS.CDSQ_MDTICKETID_EMPRESA.AsString; DMGS.VEMPRESASAUX.TIPO :='2'; OPEN; END; LISTADOS := tLISTADOS.Create(nil); PREVIO := TPREVIO.Create(NIL); LISTADOS.FRDB.DataSet := DMGS.CDSQ_TICKETAUX; LISTADOS.FRDB2.DataSet := DMGS.CDSQ_EMPRESAAUX; LISTADOS.FRDB3.DataSet := DMGS.CDSQ_CLIENTEAUX; // Path := ExtractFilePath(ParamStr(0)); LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOTICKETS.frf'); LISTADOS.frReport1.Preview := PREVIO.frPreview1; LISTADOS.frReport1.ShowReport; PREVIO.ShowModal; LISTADOS.Free; LISTADOS := NIL; PREVIO.FREE; PREVIO := NIL; DMGS.CDSQ_EMPRESAAUX.CLOSE; DMGS.CDSQ_CLIENTEAUX.CLOSE; DMGS.CDSQ_TICKETAUX.CLOSE; end; end; procedure TFMENU.Pendientes1Click(Sender: TObject); var cadena:string; begin LISTADOOPCIONESPENDIENTES := tLISTADOOPCIONESPENDIENTES.create(nil); if LISTADOOPCIONESPENDIENTES.ShowModal = mrok then begin cadena := LISTADOOPCIONESPENDIENTES.cadena; LISTADOS := tLISTADOS.Create(nil); PREVIO := TPREVIO.Create(NIL); with DMGS.CDSQ_PEDIDOSPENDIENTES do BEGIN CLOSE; IF TRIM(CADENA) <> '' THEN BEGIN DMGS.PNABGRBUSCAR:=' WHERE '+CADENA; DMGS.PNAbgrtipo:='2'; END ELSE BEGIN DMGS.PNABGRBUSCAR:='%'; DMGS.PNAbgrtipo:='1'; END; DMGS.PNABGRORDEN := ORDENPENDIENTES; OPEN; END; LISTADOS.FRDB.DataSet := DMGS.CDSQ_PEDIDOSPENDIENTESAUX; // Path := ExtractFilePath(ParamStr(0)); LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\PENDIENTES.frf'); LISTADOS.frReport1.Preview := PREVIO.frPreview1; LISTADOS.frReport1.ShowReport; PREVIO.ShowModal; LISTADOS.Free; LISTADOS := NIL; PREVIO.FREE; PREVIO := NIL; DMGS.CDSQ_PEDIDOSPENDIENTESAUX.CLOSE; END; LISTADOOPCIONESPENDIENTES.free; LISTADOOPCIONESPENDIENTES := nil; end; procedure TFMENU.Avisos2Click(Sender: TObject); var cadena:string; begin listadoopcionesAVISO := tlistadoopcionesAVISO.create(nil); if listadoopcionesAVISO.ShowModal = mrok then begin cadena := listadoopcionesAVISO.cadena; LISTADOS := tLISTADOS.Create(nil); PREVIO := TPREVIO.Create(NIL); WITH DMGS.CDSQ_AVISOAUX DO BEGIN CLOSE; IF TRIM(CADENA) <> '' THEN BEGIN DMGS.VAVISOAUX.ID:=' WHERE '+CADENA; DMGS.VAVISOAUX.TIPO:='2'; END ELSE BEGIN DMGS.VAVISOAUX.ID:='%'; DMGS.VAVISOAUX.TIPO:='1'; END; DMGS.VAVISOAUX.ORDEN := ORDENAVISO; OPEN; END; LISTADOS.FRDB.DataSet := DMGS.CDSQ_AVISOAUX; // Path := ExtractFilePath(ParamStr(0)); LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\AVISO.frf'); LISTADOS.frReport1.Preview := PREVIO.frPreview1; LISTADOS.frReport1.ShowReport; PREVIO.ShowModal; LISTADOS.Free; LISTADOS := NIL; PREVIO.FREE; PREVIO := NIL; DMGS.CDSQ_AVISOAUX.CLOSE; END; listadoopcionesAVISO.free; listadoopcionesAVISO := nil; end; procedure TFMENU.Timer1Timer(Sender: TObject); begin label4.caption:=datetostr(date); label6.caption:=timetostr(time) end; procedure TFMENU.ATICKETExecute(Sender: TObject); begin TOOLBAR1.Visible := FALSE; // TOOLBAR3.Visible := FALSE; if not Hija(TTICKET) then TTICKET.Create(self); end; procedure TFMENU.ACALCULARFAMILIASExecute(Sender: TObject); begin familia.free; familia := tfamilia.create(self); familia.crearfamilia(0,familia,DMGS.CDSQ_FAMILIASAUX); end; procedure TFMENU.aarticulosvendidosExecute(Sender: TObject); VAR CADENA:STRING; begin LISTADOOPCIONESARTICULOS := tlistadoopcionesARTICULOS.create(nil); if listadoopcionesARTICULOS.ShowModal = mrok then begin IF (TRIM(LISTADOOPCIONESARTICULOS.CALBARANES) <> '') OR (TRIM(LISTADOOPCIONESARTICULOS.CTICKETS) <> '') OR (TRIM(LISTADOOPCIONESARTICULOS.CFACTURAS) <> '') THEN BEGIN LISTADOS := tLISTADOS.Create(nil); PREVIO := TPREVIO.Create(NIL); LISTADOS.FRDB.DataSet := DMGS.CDSQ_LARTICULOS; LISTADOS.FRDB2.DataSet := DMGS.CDSQ_EMPRESAAUX; LISTADOS.FRDB3.DataSet := DMGS.CDSQ_CLIENTEAUX; LISTADOS.FECHADESDE := LISTADOOPCIONESARTICULOS.MaskEdit1.Text ; LISTADOS.FECHAHASTA := LISTADOOPCIONESARTICULOS.MaskEdit2.Text ; IF TRIM(LISTADOOPCIONESARTICULOS.CALBARANES) <> '' THEN BEGIN DMGS.CDSQ_LARTICULOS.CLOSE; DMGS.VLARTICULOS.ID1 := ''; DMGS.VLARTICULOS.ID := LISTADOOPCIONESARTICULOS.CALBARANES; DMGS.VLARTICULOS.ORDEN := LISTADOOPCIONESARTICULOS.OALBARANES; DMGS.VLARTICULOS.GRUPO := LISTADOOPCIONESARTICULOS.GALBARANES; DMGS.VLARTICULOS.TIPO := '2'; DMGS.CDSQ_LARTICULOS.Open; WHILE not dmgs.cdsq_LARTICULOS.eof do begin dmgs.cdsq_LARTICULOS.Last; if dmgs.cdsq_LARTICULOS.Eof then try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_LARTICULOS.GetNextPacket ; except end; end; dmgs.cdsq_LARTICULOS.First; IF DMGS.CDSQ_LARTICULOS.RECORDCOUNT > 0 THEN WITH DMGS.CDSQ_EMPRESAAUX DO BEGIN Close; DMGS.VEMPRESASAUX.ID:= DMGS.CDSQ_LARTICULOS.FieldValues['ID_EMPRESA']; DMGS.VEMPRESASAUX.TIPO :='2'; OPEN; END; LISTADOS.ETIQUETA := ' EN ALBARANES '; IF LISTADOOPCIONESARTICULOS.DETALLE THEN LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOARTICULOSDETALLE.frf') ELSE LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOARTICULOSGRUPOS.frf'); LISTADOS.frReport1.Preview := PREVIO.frPreview1; LISTADOS.frReport1.ShowReport; PREVIO.ShowModal; END; IF TRIM(LISTADOOPCIONESARTICULOS.CFACTURAS) <> '' THEN BEGIN DMGS.CDSQ_LARTICULOS.CLOSE; DMGS.VLARTICULOS.ID1 := ''; DMGS.VLARTICULOS.ID := LISTADOOPCIONESARTICULOS.CFACTURAS; DMGS.VLARTICULOS.ORDEN := LISTADOOPCIONESARTICULOS.OFACTURAS; DMGS.VLARTICULOS.GRUPO := LISTADOOPCIONESARTICULOS.GFACTURAS; DMGS.VLARTICULOS.TIPO := '2'; DMGS.CDSQ_LARTICULOS.Open; WHILE not dmgs.cdsq_LARTICULOS.eof do begin dmgs.cdsq_LARTICULOS.Last; if dmgs.cdsq_LARTICULOS.Eof then try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_LARTICULOS.GetNextPacket ; except end; end; dmgs.cdsq_LARTICULOS.First; IF DMGS.CDSQ_LARTICULOS.RECORDCOUNT > 0 THEN WITH DMGS.CDSQ_EMPRESAAUX DO BEGIN Close; DMGS.VEMPRESASAUX.ID:= DMGS.CDSQ_LARTICULOS.FieldValues['ID_EMPRESA']; DMGS.VEMPRESASAUX.TIPO :='2'; OPEN; END; LISTADOS.ETIQUETA := ' EN FACTURAS '; IF LISTADOOPCIONESARTICULOS.DETALLE THEN LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOARTICULOSDETALLEFACTURAS.frf') ELSE LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOARTICULOSGRUPOSFACTURAS.frf'); LISTADOS.frReport1.Preview := PREVIO.frPreview1; LISTADOS.frReport1.ShowReport; PREVIO.ShowModal; END; IF TRIM(LISTADOOPCIONESARTICULOS.CTICKETS) <> '' THEN BEGIN DMGS.CDSQ_LARTICULOS.CLOSE; DMGS.VLARTICULOS.ID1 := ''; DMGS.VLARTICULOS.ID := LISTADOOPCIONESARTICULOS.CTICKETS; DMGS.VLARTICULOS.ORDEN := LISTADOOPCIONESARTICULOS.OTICKETS; DMGS.VLARTICULOS.GRUPO := LISTADOOPCIONESARTICULOS.GTICKETS; DMGS.VLARTICULOS.TIPO := '2'; DMGS.CDSQ_LARTICULOS.Open; WHILE not dmgs.cdsq_LARTICULOS.eof do begin dmgs.cdsq_LARTICULOS.Last; if dmgs.cdsq_LARTICULOS.Eof then try // para evitar el error de memoria bloqueada en el server. DMGS.CDSQ_LARTICULOS.GetNextPacket ; except end; end; dmgs.cdsq_LARTICULOS.First; IF DMGS.CDSQ_LARTICULOS.RECORDCOUNT > 0 THEN WITH DMGS.CDSQ_EMPRESAAUX DO BEGIN Close; DMGS.VEMPRESASAUX.ID:= DMGS.CDSQ_LARTICULOS.FieldValues['ID_EMPRESA']; DMGS.VEMPRESASAUX.TIPO :='2'; OPEN; END; LISTADOS.ETIQUETA := ' EN TICKETS '; IF LISTADOOPCIONESARTICULOS.DETALLE THEN LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOARTICULOSDETALLE.frf') ELSE LISTADOS.frReport1.LoadFromFile(dmgs.Path + 'LISTADOS\LISTADOARTICULOSGRUPOS.frf'); LISTADOS.frReport1.Preview := PREVIO.frPreview1; LISTADOS.frReport1.ShowReport; PREVIO.ShowModal; END; LISTADOS.Free; LISTADOS := NIL; PREVIO.FREE; PREVIO := NIL; DMGS.CDSQ_EMPRESAAUX.CLOSE; DMGS.CDSQ_CLIENTEAUX.CLOSE; DMGS.CDSQ_TICKETAUX.CLOSE; end; END; listadoopcionesARTICULOS.FREE; listadoopcionesARTICULOS := NIL; end; procedure TFMENU.ToolButton26Click(Sender: TObject); begin CONFIGURACION := TCONFIGURACION.Create(NIL); CONFIGURACION.ShowModal; CONFIGURACION.FREE; CONFIGURACION := NIL; end; function TFMENU.impresorapordefecto(aux: string): string; var j:string; begin j:= printer.Printers[-1]; if aux<>'' then begin printer.SetPrinter(aux); j := aux; end; result := j; end; procedure TFMEnU.impresorainicial(aux: string); begin printer.SetPrinter(aux); end; function TFMENU.KillTask(FileName: String): integer; var ContinueLoop:BOOL; FSnapshotHandle:THandle; FProcessEntry32:TProcessEntry32; const PROCESS_TERMINATE=$0001; begin FSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); FProcessEntry32.dwSize:=Sizeof(FProcessEntry32); ContinueLoop:=Process32First(FSnapshotHandle,FProcessEntry32); while integer(ContinueLoop)<>0 do begin if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile))=UpperCase(FileName)) or (UpperCase(FProcessEntry32.szExeFile)=UpperCase(FileName))) then Result:=Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE,BOOL(0),FProcessEntry32.th32ProcessID),0)); ContinueLoop:=Process32Next(FSnapshotHandle,FProcessEntry32); end; CloseHandle(FSnapshotHandle); end; procedure TFMENU.ToolButton1Click(Sender: TObject); begin if not Hija(tTIPOSIVA) then TTIPOSIVA.Create(self); end; end. //*********************************************************************************************// Añade TLHelp32 en el uses de tu form procedure TForm1.Button2Click(Sender: TObject); function CierraExe (FicheroExe:string):boolean; function SacaExe(MangoW:HWND):string; {Obtiene el EXE de una tarea} {get EXE of a task} var Datos :TProcessEntry32; hID :DWord; Snap : Integer; begin GetWindowThreadProcessId(MangoW,@hID); Snap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); try Datos.dwSize:=SizeOf(Datos); if(Process32First(Snap,Datos))then begin repeat if Datos.th32ProcessID=hID then begin Result:=StrPas(Datos.szExeFile); Break; end; until not(Process32Next(Snap,Datos)); end; finally Windows.CloseHandle(Snap); end; end; function ObtieneVentanas(Mango: HWND; ACerrar: Pointer): Boolean; stdcall; begin Result := True; {Mango es el handle de la tarea encontrada} {Si es el .EXE buscado, lo cierra} if SacaExe(Mango)=UpperCase( String(ACerrar^) )then begin SendMessage(Mango,WM_Close,0,0); String(Acerrar^):='CERRADO'; end; end; begin EnumWindows( @ObtieneVentanas, Integer(@FicheroExe) ); Result:=(FicheroExe='CERRADO'); end; begin if CierraExe('C:\WINDOWS\NOTEPAD.EXE') then ShowMessage ('Cerrado/Closed') else ShowMessage ('No Encontrado/not Found'); end; Otro método más sencillo: procedure TForm1.Button1Click(Sender: TObject); function KillTask(FileName:String):integer; var ContinueLoop:BOOL; FSnapshotHandle:THandle; FProcessEntry32:TProcessEntry32; const PROCESS_TERMINATE=$0001; begin FSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); FProcessEntry32.dwSize:=Sizeof(FProcessEntry32); ContinueLoop:=Process32First(FSnapshotHandle,FProcessEntry32); while integer(ContinueLoop)<>0 do begin if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile))=UpperCase(FileName)) or (UpperCase(FProcessEntry32.szExeFile)=UpperCase(FileName))) then Result:=Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE,BOOL(0), FProcessEntry32.th32ProcessID),0)); ContinueLoop:=Process32Next(FSnapshotHandle,FProcessEntry32); end; CloseHandle(FSnapshotHandle); end; begin KillTask('Notepad.exe'); end;