Skip to content

Instantly share code, notes, and snippets.

/UClientes

Created June 2, 2013 07:54
Show Gist options
  • Save anonymous/5692959 to your computer and use it in GitHub Desktop.
Save anonymous/5692959 to your computer and use it in GitHub Desktop.
Download ZIP
Módulo de clientes de programa de Gestión desde 0
Raw
UClientes
unit UCLIENTES;
{$R BOTONERA.RES}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, IBDatabase,
MMSystem, //Para la botonera
NewPanelDB, //Para usar el NEwPanelDB
SPBBC, //Para TSpeedButtonBC
Lapelpanel, //Para paneles con solapa
MyDbIbMemo, //Para DbiMemo
TDbIbchkbox, //Para campos boolean en Firebird
Mask, DbEditDefault, //PAra usar los DbeditDefault en vez de los Dbedit normal
DBCBEXT, //Para usar el DbCombobox Extendido
GroupboxJL, //Para usar el CgoupBox especial
Dialogs, ComCtrls, ExtCtrls, Grids, DBGrids, StdCtrls, Spin, Buttons, DB, DBCtrls,
IBCustomDataSet, IBQuery, ExtDlgs,Clipbrd, jpeg, ShellAPI;
type
TFCLIENTES = class(TForm)
PanelBotonera: TNewPanelDB;
SBBarraStatus: TStatusBar;
Panel1: TPanel;
Panel2: TPanel;
PanelDatos: TNewPanelDB;
Panel3: TPanel;
DBGNoEnable: TDBGrid;
PanelConfirmar: TNewPanelDB;
DsPrincipal: TDataSource;
SBPrimero: TSpeedButtonBC;
SBMenosx: TSpeedButtonBC;
SBMenos1: TSpeedButtonBC;
SBMas1: TSpeedButtonBC;
SBMasX: TSpeedButtonBC;
SBUltimo: TSpeedButtonBC;
SbNuevo: TSpeedButtonBC;
SbModificar: TSpeedButtonBC;
SbBorrar: TSpeedButtonBC;
SB_Salir: TSpeedButtonBC;
SBBuscar: TSpeedButtonBC;
SBImprimir: TSpeedButtonBC;
SBConfirmar: TSpeedButtonBC;
SBCancelar: TSpeedButtonBC;
Label14: TLabel;
SEMobeByX: TSpinEdit;
GBBuscar: TGroupBoxJL;
Ebusqueda: TEdit;
BLimpiar: TButton;
BBuscar: TButton;
BCerrar: TButton;
GBImprimir: TGroupBoxJL;
CBVistaPrevia: TCheckBox;
CBVerDialogo: TCheckBox;
BCerrarIMP: TButton;
Timer1: TTimer;
PGc: TPageControl;
Panel4: TPanel;
Panel5: TPanel;
Panel6: TPanel;
Panel7: TPanel;
DATOS: TTabSheet;
OTROS: TTabSheet;
Direcciones: TTabSheet;
PC: TTabSheet;
Label1: TLabel;
DBEdit1: TDBEdit;
Label2: TLabel;
DBEdit2: TDBEdit;
Label3: TLabel;
DBEdit3: TDBEdit;
Label4: TLabel;
DBEdit4: TDBEdit;
Label5: TLabel;
DBEdit5: TDBEdit;
Label6: TLabel;
DBEdit6: TDBEdit;
Label7: TLabel;
DBEdit7: TDBEdit;
Label8: TLabel;
DBEdit8: TDBEdit;
Label9: TLabel;
DBEdit9: TDBEdit;
Label10: TLabel;
DBEdit10: TDBEdit;
Label11: TLabel;
DBEdit11: TDBEdit;
Label12: TLabel;
DBEdit12: TDBEdit;
Label13: TLabel;
DBEdit13: TDBEdit;
Label15: TLabel;
DBEdit14: TDBEdit;
Label16: TLabel;
DBEdit15: TDBEdit;
Label17: TLabel;
DBEdit16: TDBEdit;
Label18: TLabel;
DBEdit17: TDBEdit;
Label19: TLabel;
DBEdit18: TDBEdit;
Label20: TLabel;
DBImage1: TDBImage;
DBIBMemo2: TDBIBMemo;
CONTACTOS: TTabSheet;
BANCOS: TTabSheet;
DBIBMemo1: TDBIBMemo;
Panel8: TPanel;
Panel9: TPanel;
SpeedButtonBC1: TSpeedButtonBC;
SpeedButtonBC2: TSpeedButtonBC;
dsconfi: TDataSource;
IBQDir: TIBQuery;
Panel10: TPanel;
SpeedButtonBC3: TSpeedButtonBC;
DSIBQDir: TDataSource;
IBQDirID: TIntegerField;
IBQDirMODULO: TIBStringField;
IBQDirCODIGO: TIBStringField;
IBQDirDIRECCION: TIBStringField;
IBQDirCP: TIBStringField;
IBQDirPOBLACION: TIBStringField;
IBQDirPROVINCIA: TIBStringField;
IBQDirTF: TIBStringField;
IBQDirNOTA: TWideMemoField;
IBQDirPAIS: TIBStringField;
DBGrid1: TDBGrid;
Label21: TLabel;
DBEdit19: TDBEdit;
Label22: TLabel;
DBEdit20: TDBEdit;
DBIBMemo3: TDBIBMemo;
SpeedButtonBC4: TSpeedButtonBC;
SpeedButtonBC5: TSpeedButtonBC;
SpeedButtonBC6: TSpeedButtonBC;
SpeedButtonBC7: TSpeedButtonBC;
SpeedButtonBC8: TSpeedButtonBC;
Label23: TLabel;
Label24: TLabel;
SpeedButtonBC9: TSpeedButtonBC;
OpenPictureDialog1: TOpenPictureDialog;
SpeedButtonBC10: TSpeedButtonBC;
SpeedButtonBC11: TSpeedButtonBC;
SpeedButtonBC12: TSpeedButtonBC;
DBText1: TDBText;
Panel13: TPanel;
SpeedButtonBC15: TSpeedButtonBC;
SpeedButtonBC16: TSpeedButtonBC;
Panel14: TPanel;
Panel11: TPanel;
SpeedButtonBC13: TSpeedButtonBC;
SpeedButtonBC14: TSpeedButtonBC;
Panel12: TPanel;
Panel15: TPanel;
SpeedButtonBC17: TSpeedButtonBC;
SpeedButtonBC18: TSpeedButtonBC;
Panel16: TPanel;
Image1: TImage;
Image2: TImage;
Image3: TImage;
Image4: TImage;
Label25: TLabel;
DBEdit21: TDBEdit;
DBIBMemo4: TDBIBMemo;
DBGrid2: TDBGrid;
Label26: TLabel;
DBEdit22: TDBEdit;
DSIBQPC: TDataSource;
IBQPC: TIBQuery;
IBQPCID: TIntegerField;
IBQPCMODULO: TIBStringField;
IBQPCCODIGO: TIBStringField;
IBQPCNOMBRE: TIBStringField;
IBQPCMOVIL: TIBStringField;
IBQPCEMAIL: TIBStringField;
IBQPCCASADO: TIBStringField;
IBQPCHIJOS: TIBStringField;
IBQPCFECHANACIM: TDateField;
IBQPCPUESTO: TIBStringField;
IBQPCEXT: TIBStringField;
IBQPCNOTAS: TWideMemoField;
IBQPCFOTO: TBlobField;
DBImage2: TDBImage;
DBNavigator1: TDBNavigator;
Label27: TLabel;
DBEdit23: TDBEdit;
Label28: TLabel;
DBEdit24: TDBEdit;
DBIBMemo5: TDBIBMemo;
DBGrid3: TDBGrid;
DSIBQCon: TDataSource;
IBQCont: TIBQuery;
IBQContID: TIntegerField;
IBQContMODULO: TIBStringField;
IBQContCODIGO: TIBStringField;
IBQContNOMBRE: TIBStringField;
IBQContTF: TIBStringField;
IBQContTF2: TIBStringField;
IBQContFAX: TIBStringField;
IBQContMAIL: TIBStringField;
IBQContMAIL2: TIBStringField;
IBQContWEB: TIBStringField;
IBQContCLAVEWEB: TIBStringField;
IBQContMOVIL: TIBStringField;
IBQContMOVIL2: TIBStringField;
IBQContNOTAS: TWideMemoField;
Label29: TLabel;
DBEdit25: TDBEdit;
Label30: TLabel;
DBEdit26: TDBEdit;
Label31: TLabel;
DBEdit27: TDBEdit;
Label32: TLabel;
DBEdit28: TDBEdit;
Label33: TLabel;
DBEdit29: TDBEdit;
Label34: TLabel;
DBEdit30: TDBEdit;
DBGrid4: TDBGrid;
DSIBQBCOS: TDataSource;
IBQBcos: TIBQuery;
IBQBcosID: TIntegerField;
IBQBcosMODULO: TIBStringField;
IBQBcosCODIGO: TIBStringField;
IBQBcosBANCO: TIBStringField;
IBQBcosENTIDAD: TIntegerField;
IBQBcosOFICINA: TIntegerField;
IBQBcosDC: TIntegerField;
IBQBcosCUENTA: TIntegerField;
IBQBcosTF: TIBStringField;
Label35: TLabel;
DBEdit31: TDBEdit;
DataSource1: TDataSource;
Label36: TLabel;
DBEdit32: TDBEdit;
Label37: TLabel;
DBEdit33: TDBEdit;
Label38: TLabel;
DBEdit34: TDBEdit;
Label39: TLabel;
DBEdit35: TDBEdit;
Label40: TLabel;
DBEdit36: TDBEdit;
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure SBPrimeroClick(Sender: TObject);
procedure SBMenosxClick(Sender: TObject);
procedure SBMenos1Click(Sender: TObject);
procedure SBMas1Click(Sender: TObject);
procedure SBMasXClick(Sender: TObject);
procedure SBUltimoClick(Sender: TObject);
procedure SbNuevoClick(Sender: TObject);
procedure SbModificarClick(Sender: TObject);
procedure SbBorrarClick(Sender: TObject);
procedure SBBuscarClick(Sender: TObject);
procedure BLimpiarClick(Sender: TObject);
procedure BBuscarClick(Sender: TObject);
procedure BCerrarClick(Sender: TObject);
procedure EbusquedaChange(Sender: TObject);
procedure SBImprimirClick(Sender: TObject);
procedure BCerrarIMPClick(Sender: TObject);
procedure SB_SalirClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure SBCancelarClick(Sender: TObject);
procedure SBConfirmarClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure SpeedButtonBC2Click(Sender: TObject);
procedure SpeedButtonBC3Click(Sender: TObject);
procedure DSPrincipalDataChange(Sender: TObject; Field: TField);
procedure SpeedButtonBC1Click(Sender: TObject);
procedure SpeedButtonBC6Click(Sender: TObject);
procedure SpeedButtonBC5Click(Sender: TObject);
procedure SpeedButtonBC4Click(Sender: TObject);
procedure SpeedButtonBC7Click(Sender: TObject);
procedure SpeedButtonBC8Click(Sender: TObject);
procedure SpeedButtonBC9Click(Sender: TObject);
procedure SpeedButtonBC10Click(Sender: TObject);
procedure SpeedButtonBC11Click(Sender: TObject);
procedure SpeedButtonBC12Click(Sender: TObject);
procedure DBEdit4Enter(Sender: TObject);
procedure DBEdit4KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure DBEdit6Exit(Sender: TObject);
procedure DBEdit9Exit(Sender: TObject);
procedure DBEdit6Change(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure SpeedButtonBC14Click(Sender: TObject);
procedure SpeedButtonBC13Click(Sender: TObject);
procedure DBGNoEnableDrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure DBGrid2DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure DBGrid3DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure SpeedButtonBC18Click(Sender: TObject);
procedure SpeedButtonBC17Click(Sender: TObject);
procedure SpeedButtonBC16Click(Sender: TObject);
procedure SpeedButtonBC15Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FCLIENTES: TFCLIENTES;
IBT:TIBTransaction;
VarSSQLDir,varSSQLPc,VarSSQLCont,VarSSQLBan:string;
implementation
{$R *.dfm}
uses UDM, Fun,FUN_DBGRID, Fun_Errores ,Umenu ,Udirecciones, UPC, UContactos, UBancos;
procedure TFCLIENTES.BBuscarClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ Buscar ]******
//------------------------------------------------------------------------------
var Campo:string;
begin
Campo:='NOMBRE'; {Dato a rellenar por el progrmador con el nombre del campo en la busqueda}
DSPrincipal.DataSet.Locate(Campo,Ebusqueda.Text,[loCaseInsensitive,loPartialKey]);
end;
procedure TFCLIENTES.BCerrarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Cerrar Busqueda ]******
//------------------------------------------------------------------------------
begin
BLimpiarClick(Sender);
GBBuscar.Visible:=False;
end;
procedure TFCLIENTES.BCerrarIMPClick(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************[ Cerrar Imrprimir ]******
//------------------------------------------------------------------------------
begin
GBImprimir.Visible:=False;
end;
procedure TFCLIENTES.BLimpiarClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************[ Limpia la busqueda ]******
//------------------------------------------------------------------------------
begin
Ebusqueda.Text:='';
BBuscarClick(Sender);
Ebusqueda.SetFocus;
end;
procedure TFCLIENTES.DBEdit4Enter(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************************[ Fecha de alta ]****
//------------------------------------------------------------------------------
begin
if DBEdit4.Text='' then FECHA_DBEDIT_ENTER(DBEdit4);
end;
procedure TFCLIENTES.DBEdit4KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
//------------------------------------------------------------------------------
//***************************************[ Cambiar la fecha con las teclas ]****
//------------------------------------------------------------------------------
begin
FECHA_DBEDIT(DBEdit4,Key)
end;
procedure TFCLIENTES.DBEdit6Change(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Para varios ]****
// Para que sólo admita los Caracteres S N s n
//------------------------------------------------------------------------------
begin
TDBEdit(Sender).Text:=EditLogico(TEdit(Sender));
end;
procedure TFCLIENTES.DBEdit6Exit(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Usar Impuestos ]****
// Para usar impuestos con por defecto sea S de Si
//------------------------------------------------------------------------------
begin
DBEdit6.Text:=EditSalida(TEdit(Sender),'S');
end;
procedure TFCLIENTES.DBEdit9Exit(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Usar en varios ]****
// Para usar en varios con por defecto sea N de No
//------------------------------------------------------------------------------
begin
TDBEdit(Sender).Text:=EditSalida(TEdit(Sender));
end;
procedure TFCLIENTES.DBGNoEnableDrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
//------------------------------------------------------------------------------
//******************************************************[ ZEbrado del Grid ]****
//------------------------------------------------------------------------------
begin
Zebrado(DsPrincipal,DBGNoEnable, Rect, Column, State, COLOR1GRID,COLOR2GRID);
end;
procedure TFCLIENTES.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
//------------------------------------------------------------------------------
//******************************************************[ ZEbrado del Grid ]****
//------------------------------------------------------------------------------
begin
Zebrado(DSIBQDir,DBGrid1, Rect, Column, State, COLOR1GRID,COLOR2GRID);
end;
procedure TFCLIENTES.DBGrid2DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
//------------------------------------------------------------------------------
//******************************************************[ ZEbrado del Grid ]****
//------------------------------------------------------------------------------
begin
Zebrado(DSIBQPC,DBGrid2, Rect, Column, State, COLOR1GRID,COLOR2GRID);
end;
procedure TFCLIENTES.DBGrid3DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
//------------------------------------------------------------------------------
//******************************************************[ ZEbrado del Grid ]****
//------------------------------------------------------------------------------
begin
Zebrado(DSIBQCon,DBGrid3, Rect, Column, State, COLOR1GRID,COLOR2GRID);
end;
procedure TFCLIENTES.DSPrincipalDataChange(Sender: TObject; Field: TField);
//------------------------------------------------------------------------------
//***********************************************************[ Data Change ]****
//------------------------------------------------------------------------------
begin
if (not (DsPrincipal.DataSet.State in [dsEdit,dsInsert])) and (FCLIENTES.Active) then //Si no estamos editando y la página esta activa
begin //Aqui se activan los cambios en tiemmpo de ejecucion del las diferentes modalidades
ActQuery(IBQDir,'SELECT * FROM DIRECCIONES WHERE (DIRECCIONES.MODULO = '+QuotedStr('CLIENTES')+') AND (DIRECCIONES.CODIGO = '+QuotedStr(DBEdit1.Text)+')');
ActQuery(IBQPC,'SELECT * FROM PC WHERE (PC.MODULO = '+QuotedStr('CLIENTES')+') AND (PC.CODIGO = '+QuotedStr(DBEdit1.Text)+')');
ActQuery(IBQCont,'SELECT * FROM CONTACTOS WHERE (CONTACTOS.MODULO = '+QuotedStr('CLIENTES')+') AND (CONTACTOS.CODIGO = '+QuotedStr(DBEdit1.Text)+')');
ActQuery(IBQBcos,'Select * From BCOS WHERE (BCOS.MODULO = '+QuotedStr('CLIENTES')+') AND (BCOS.CODIGO = '+QuotedStr(DBEdit1.Text)+')');
end;
end;
procedure TFCLIENTES.EbusquedaChange(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************[ Mientras se escribe en busqueda ]******
//------------------------------------------------------------------------------
begin
BBuscarClick(sender);
end;
procedure TFCLIENTES.FormActivate(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************[ Cuando se activa El form ]******
// Lo que queremos que haga nuestro Form Cuando se Actiba
//------------------------------------------------------------------------------
begin
//Carganmos las imagenes de los botones
SBPrimero.Glyph.Handle:=Loadbitmap(HInstance,'FIRST');
SBMenosx.Glyph.Handle:=Loadbitmap(HInstance,'RETROCEDER');
SBMenos1.Glyph.Handle:=Loadbitmap(HInstance,'PRIOR');
SBMas1.Glyph.Handle:=Loadbitmap(HInstance,'NEXT');
SBMasX.Glyph.Handle:=Loadbitmap(HInstance,'AVANZAR');
SBUltimo.Glyph.Handle:=Loadbitmap(HInstance,'LAST');
SbNuevo.Glyph.Handle:=Loadbitmap(HInstance,'NUEVO');
SbModificar.Glyph.Handle:=Loadbitmap(HInstance,'EDIT');
SbBorrar.Glyph.Handle:=Loadbitmap(HInstance,'BORRAR');
SB_Salir.Glyph.Handle:=Loadbitmap(HInstance,'SALIR');
SBBuscar.Glyph.Handle:=Loadbitmap(HInstance,'BUSCAR');
SBImprimir.Glyph.Handle:=Loadbitmap(HInstance,'IMPRIMIR');
SBConfirmar.Glyph.Handle:=Loadbitmap(HInstance,'CHECKROUND');
SBCancelar.Glyph.Handle:=Loadbitmap(HInstance,'CANCEL');
if Timer1.Enabled=false then Timer1.Enabled:=True;
//Ponemos el Juego de colores de mis NewPanelDB
PanelBotonera.ColorNotActive:=COLORPANELACT;
PanelBotonera.ActiveColor:=COLORPANELNOACT;
PanelDatos.ActiveColor:=COLORPANELACT;
PanelDatos.ColorNotActive:=COLORPANELNOACT;
PanelConfirmar.ActiveColor:=COLORPANELACT;
PanelConfirmar.ColorNotActive:=COLORPANELNOACT;
end;
procedure TFCLIENTES.FormClose(Sender: TObject; var Action: TCloseAction);
//------------------------------------------------------------------------------
//*************************************************[ Al Cerrarse El Form ]******
// Cerramos todos los procesos para que no consuman memoria y posibles errores
//------------------------------------------------------------------------------
begin
if Timer1.Enabled=true then Timer1.Enabled:=False;
QuerryOC(IBQDir);
QuerryOC(IBQPC);
QuerryOC(IBQCont);
QuerryOC(IBQBcos);
end;
procedure TFCLIENTES.FormCreate(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************[ Al Crearse el Fom ]******
// Cosas que queremos que haga según se inicie el Form
//------------------------------------------------------------------------------
begin
IBT:=UDM.DM.IBTransaction1; // Aquí especificar el modulo y el IBTransaction a usar
PGc.ActivePage:=DATOS;
end;
procedure TFCLIENTES.FormKeyPress(Sender: TObject; var Key: Char);
//------------------------------------------------------------------------------
//************************************************[ Al pulsar una tecla ]******
// Al pulsar la tecla salta al foco del siguiente componente, si esta admitido
//------------------------------------------------------------------------------
begin
if (Key = #13) then {Si se ha pulsado enter }
if (ActiveControl is TEdit)
or (ActiveControl is TDBEdit)
or (ActiveControl is TDBComboBox) then
begin
Key := #0; { anula la puulsación }
Perform(WM_NEXTDLGCTL, 0, 0); { mueve al próximo control }
end
end;
procedure TFCLIENTES.FormShow(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************************[ OnShow ]****
//------------------------------------------------------------------------------
begin
ActQuery(IBQDir,'SELECT * FROM DIRECCIONES WHERE (DIRECCIONES.MODULO = '+QuotedStr('CLIENTES')+') AND (DIRECCIONES.CODIGO = '+QuotedStr(DBEdit1.Text)+')');
ActQuery(IBQPC,'SELECT * FROM PC WHERE (PC.MODULO = '+QuotedStr('CLIENTES')+') AND (PC.CODIGO = '+QuotedStr(DBEdit1.Text)+')');
ActQuery(IBQCont,'SELECT * FROM CONTACTOS WHERE (CONTACTOS.MODULO = '+QuotedStr('CLIENTES')+') AND (CONTACTOS.CODIGO = '+QuotedStr(DBEdit1.Text)+')');
ActQuery(IBQBcos,'Select * From BCOS WHERE (BCOS.MODULO = '+QuotedStr('CLIENTES')+') AND (BCOS.CODIGO = '+QuotedStr(DBEdit1.Text)+')');
end;
procedure TFCLIENTES.SbBorrarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Borrar el Actual Registro ]******
//------------------------------------------------------------------------------
begin //Cambiar por el mensaje elegido
PGc.ActivePage:=DATOS;
if (MessageBox(0, '¿Esta seguro de eliminar el registro actual?'
+#13#10+'La eliminación del actual registro afectara a otros modulos'
+#13#10+'y a los datos de este cliente que le han sido facturados',
'Eliminar Registro', MB_ICONSTOP or MB_YESNO or MB_DEFBUTTON2) = ID_No) then abort
else begin
VarsCod:=DBEdit1.Field.Value;
Case Application.MessageBox(pchar('El Registro ha sido eliminado, desea seguir adelante o recuperar lo?'
+#13#10
+#13#10
+#13#10+'Si elige [ SI ] se borrara permanente, así como los datos derivados'
+#13#10+'Si elige [ NO ] se recupera el registro borrado'), pchar('Registro Eliminado'), 4+48+256) of
6:begin //Si al borrado, 1º borramos todas las bases auxiliares
//Direcciones
try
ActIbdataset(DM.IBDirecciones,'DELETE FROM DIRECCIONES WHERE (DIRECCIONES.MODULO = '+QuotedStr('CLIENTES')+') AND (DIRECCIONES.CODIGO = '+QuotedStr(VarsCod)+')');
ActIbdataset(DM.IBDirecciones,'SELECT * FROM DIRECCIONES');
//Bancos
ActIbdataset(DM.IBDBcos,'DELETE FROM BCOS WHERE (BCOS.MODULO = '+QuotedStr('CLIENTES')+') AND (BCOS.CODIGO = '+QuotedStr(VarsCod)+')');
ActIbdataset(DM.IBDBcos,'SELECT * FROM BCOS');
//Contactos
ActIbdataset(DM.IBDContacto,'DELETE FROM CONTACTOS WHERE (CONTACTOS.MODULO = '+QuotedStr('CLIENTES')+') AND (CONTACTOS.CODIGO = '+QuotedStr(VarsCod)+')');
ActIbdataset(DM.IBDContacto,'SELECT * FROM CONTACTOS');
//Personas de contacto
ActIbdataset(DM.IBDPC,'DELETE FROM PC WHERE (PC.MODULO = '+QuotedStr('CLIENTES')+') AND (PC.CODIGO = '+QuotedStr(VarsCod)+')');
ActIbdataset(DM.IBDPC,'SELECT * FROM PC');
DSPrincipal.DataSet.Delete;
IBT.CommitRetaining;
ShowMessage('Se han borrado los datos de este cliente y los modulos relacionados con el');
except
Case Application.MessageBox( pchar( 'Se ha producido un error y no se ha podido borrar todos los datos'
+#13#10
+#13#10+'Que desea hacer?'
+#13#10
+#13#10+'ACEPTAR y eliminar de manera permanente los datos que se han borrado'
+#13#10+'CANCELAR y no borrar nada'), pchar('Se ha producido un error'), 1+48+256) of
1:IBT.CommitRetaining; //Aceptar
2:IBT.RollbackRetaining; //Cancelar
end;
end;
end;
7:begin //No
IBT.RollbackRetaining; //anulamos la eliminación
end;
end;
end;
end;
procedure TFCLIENTES.SBBuscarClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Abrir Busqueda ]******
//------------------------------------------------------------------------------
begin
GBBuscar.Visible:=True;
Ebusqueda.SetFocus;
end;
procedure TFCLIENTES.SBCancelarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Cancelar Proceso]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Cancel;
IBT.RollbackRetaining; //Donde IBT es el nombre de su Ibtrasaction, con ruta
end;
procedure TFCLIENTES.SBConfirmarClick(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Grabar datos ]******
//------------------------------------------------------------------------------
var varicodigo:Integer;
begin
try
DSPrincipal.DataSet.Post;
IBDSACT(DM.IBDCONFI);
//Aqui grabamos el núevo codigo si es necesario en confi
if dsconfi.DataSet.FieldByName('NUMEROCLIENTE').IsNull then
begin
VarICodigo:=1;
dsconfi.DataSet.Edit;
dsconfi.DataSet.FieldByName('NUMEROCLIENTE').Value:=IntToStr(varicodigo);
dsconfi.DataSet.Post;
end else
begin
VarICodigo:=SoloInteger(dsconfi.DataSet.FieldByName('NUMEROCLIENTE').Value)+1;
if varicodigo>SoloInteger(dsconfi.DataSet.FieldByName('NUMEROCLIENTE').Value) then
begin
dsconfi.DataSet.Edit;
dsconfi.DataSet.FieldByName('NUMEROCLIENTE').Value:=IntToStr(varicodigo);
dsconfi.DataSet.Post;
end;
end;
IBT.CommitRetaining; //Donde IBT es el nombre de su Ibtrasaction, con ruta
except
on E: Exception do
begin
MessageBeep(1000);
ShowMessage('Se ha producido un error y el proceso no se ha podido terminar Unidad:[ UCLIENTES ] Modulo:[ Grabar ]' + Chr(13) + Chr(13)
+ 'Clase de error: ' + E.ClassName + Chr(13) + Chr(13)
+ 'Mensaje del error:' + E.Message+Chr(13) + Chr(13)
+ ' '+Chr(13) + Chr(13)
+ 'El proceso ha quedado interrumpido');
if DsPrincipal.DataSet.State in [dsEdit, dsInsert] then DSPrincipal.DataSet.Cancel;
IBT.RollbackRetaining; //Donde IBT es el nombre de su Ibtrasaction, con ruta
end;
end;
end;
procedure TFCLIENTES.SBImprimirClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Abrir Imprimir ]******
//------------------------------------------------------------------------------
begin
GBImprimir.Visible:=True;
end;
procedure TFCLIENTES.SBMas1Click(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************[ Avanzar un registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Next;
end;
procedure TFCLIENTES.SBMasXClick(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************[ Avanzar x Registros ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.MoveBy(SEMobeByX.Value);
end;
procedure TFCLIENTES.SBMenos1Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Retroceder 1 registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Prior;
end;
procedure TFCLIENTES.SBMenosxClick(Sender: TObject);
//------------------------------------------------------------------------------
//**********************************************[ Retroceder x Registros ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.MoveBy(-SEMobeByX.Value);
end;
procedure TFCLIENTES.SbModificarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Editar el actual registro ]******
//------------------------------------------------------------------------------
begin
PGc.ActivePage:=DATOS;
if DsPrincipal.DataSet.IsEmpty<>true then
begin
DSPrincipal.DataSet.Edit;
DBEdit1.SetFocus;
end else ShowMessage('No hay tregistros disponibles para editar')
end;
procedure TFCLIENTES.SbNuevoClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Creamos un nuevo registro ]******
//------------------------------------------------------------------------------
var VarICodigo:Integer;
begin
PGc.ActivePage:=DATOS;
DBIBMemo1.Lines.Clear;
DBIBMemo2.Lines.Clear;
DSPrincipal.DataSet.Insert;
DsPrincipal.DataSet.FieldByName('NOMMODULO').Value:='CLIENTES';
// Damos el Código al Cliente
if dsconfi.DataSet.FieldByName('NUMEROCLIENTE').IsNull then VarICodigo:=1
else VarICodigo:=SoloInteger(dsconfi.DataSet.FieldByName('NUMEROCLIENTE').Value)+1;
DBEdit1.Field.Value:=IntToStr(VarICodigo);
DBEdit1.SetFocus;
end;
procedure TFCLIENTES.SBPrimeroClick(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Ir al Primer Registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.First;
end;
procedure TFCLIENTES.SBUltimoClick(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Ir al último registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Last;
end;
procedure TFCLIENTES.SB_SalirClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Salir Del Form ]******
//------------------------------------------------------------------------------
begin
FCLIENTES.Close;
end;
procedure TFCLIENTES.SpeedButtonBC10Click(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************************[ Botón pegar ]******
// código bajado de http://www.clubdelphi.com/foros/showthread.php?t=57360
// Del compañero Gluglu, para pegar desde el portapapeles
// Añadir al Uses las unit Clipbrd, jpeg, ShellAPI
//------------------------------------------------------------------------------
var
f : TFileStream;
Jpg : TJpegImage;
Hand : THandle;
Buffer : Array [0..MAX_PATH] of Char;
numFiles : Integer;
File_Name : String;
Jpg_Bmp : String;
BitMap : TBitMap;
ImageAux : TImage;
begin
ImageAux := TImage.Create(Self);
if Clipboard.HasFormat(CF_HDROP) then begin
Clipboard.Open;
try
Hand := Clipboard.GetAsHandle(CF_HDROP);
If Hand <> 0 then begin
numFiles := DragQueryFile(Hand, $FFFFFFFF, nil, 0) ; //Unit ShellApi
if numFiles > 1 then begin
Clipboard.Close;
ImageAux.Free;
Errorx('Pegar','Clientes','Pegar','El Portapapeles contiene más de un único fichero. No es posible pegar','','',False,clSkyBlue,clNavy,500);
Exit;
end;
Buffer[0] := #0;
DragQueryFile( Hand, 0, buffer, sizeof(buffer)) ;
File_Name := buffer;
end;
finally
Clipboard.close;
end;
f := TFileStream.Create(File_Name, fmOpenRead);
Jpg := TJpegImage.Create;
Bitmap := TBitmap.Create;
// Check if Jpg File
try
Jpg.LoadFromStream(f);
ImageAux.Picture.Assign(Jpg);
Jpg_Bmp := 'JPG';
except
f.seek(0,soFromBeginning);
Jpg_Bmp := '';
end;
if Jpg_Bmp = '' then begin
try
Bitmap.LoadFromStream(f);
Jpg.Assign(Bitmap);
ImageAux.Picture.Assign(Jpg);
Jpg_Bmp := 'BMP';
except
Jpg_Bmp := '';
end;
end;
Jpg.Free;
Bitmap.Free;
f.Free;
if Jpg_Bmp = '' then begin
ImageAux.Free;
Errorx('Pegar-2','Clientes','Pegar','Fichero seleccionado no contiene ninguna Imagen del Tipo JPEG o BMP','','',False,clSkyBlue,clNavy,500);
Exit;
end;
end
else if Clipboard.HasFormat(CF_BITMAP) then
ImageAux.Picture.Assign(Clipboard)
else begin
ImageAux.Free;
Errorx('Pegar-3','Clientes','Pegar','El Portapapeles no contiene ninguna Imagen del Tipo JPEG o BMP','','',False,clSkyBlue,clNavy,500);
Exit;
end;
Jpg := TJpegImage.Create;
try
Jpg.Assign(ImageAux.Picture.Graphic);
except
ImageAux.Free;
Errorx('Pegar-4','Clientes','Pegar','El Portapapeles no contiene ninguna Imagen del Tipo JPEG o BMP','','',False,clSkyBlue,clNavy,500);
Jpg.Free;
Exit;
end;
Jpg.Free;
DBImage1.Picture.Assign(ImageAux.Picture);
end;
procedure TFCLIENTES.SpeedButtonBC11Click(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************************[Ir a otros ]****
//------------------------------------------------------------------------------
begin
PGc.ActivePage:=OTROS;
end;
procedure TFCLIENTES.SpeedButtonBC12Click(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************************[Ir a datos ]****
//------------------------------------------------------------------------------
begin
PGc.ActivePage:=DATOS;
end;
procedure TFCLIENTES.SpeedButtonBC13Click(Sender: TObject);
//------------------------------------------------------------------------------
//**********************************[ Modificar borrar Persona de contacto ]****
//------------------------------------------------------------------------------
begin
SpeedButtonBC4Click(sender);
if DBEdit1.Text<>'' then
begin
VarSNomMod:='CLIENTES';
VarsCod:=DBEdit1.Field.Value;
ActIbdataset(DM.IBDPC,'SELECT * FROM CONTACTOS WHERE (CONTACTOS.MODULO = '+QuotedStr('CLIENTES')+') AND (CONTACTOS.CODIGO = '+QuotedStr(DBEdit1.Text)+')');
FPC.Show;
end else ShowMessage('Debe crear y seleccionar el cliente para poder modificar/borrar la Persona de contacto');
end;
procedure TFCLIENTES.SpeedButtonBC14Click(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************[ Nueva Persona de contacto ]****
//------------------------------------------------------------------------------
begin
SpeedButtonBC4Click(sender);
if DBEdit1.Text<>'' then
begin
VarSNomMod:='CLIENTES';
VarsCod:=DBEdit1.Field.Value;
FPC.Show;
FPC.SbNuevoClick(Sender);
FPC.DBEdit3.SetFocus;
end else ShowMessage('Debe crear y seleccionar el cliente para poder crearle una nueva persona de contacto');
end;
procedure TFCLIENTES.SpeedButtonBC15Click(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************************[ Modificar borrar Dirección ]****
//------------------------------------------------------------------------------
begin
SpeedButtonBC6Click(sender);
if DBEdit1.Text<>'' then
begin
VarSNomMod:='CLIENTES';
VarsCod:=DBEdit1.Field.Value;
ActIbdataset(DM.IBDirecciones,'SELECT * FROM DIRECCIONES WHERE (DIRECCIONES.MODULO = '+QuotedStr('CLIENTES')+') AND (DIRECCIONES.CODIGO = '+QuotedStr(DBEdit1.Text)+')');
Fdirecciones.Show;
end else ShowMessage('Debe crear y seleccionar el cliente para poder modificar/borrar la dirección');
end;
procedure TFCLIENTES.SpeedButtonBC16Click(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************************[ Nueva Dirección ]****
//------------------------------------------------------------------------------
begin
SpeedButtonBC6Click(sender);
if DBEdit1.Text<>'' then
begin
VarSNomMod:='CLIENTES';
VarsCod:=DBEdit1.Field.Value;
Fdirecciones.Show;
Fdirecciones.SbNuevoClick(Sender);
Fdirecciones.DBEdit3.SetFocus;
end else ShowMessage('Debe crear y seleccionar el cliente para poder crearle una nueva dirección');
end;
procedure TFCLIENTES.SpeedButtonBC17Click(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************[ Modificar/borrar contacto ]****
//------------------------------------------------------------------------------
begin
SpeedButtonBC7Click(sender);
if DBEdit1.Text<>'' then
begin
VarSNomMod:='CLIENTES';
VarsCod:=DBEdit1.Field.Value;
ActIbdataset(DM.IBDContacto,'SELECT * FROM CONTACTOS WHERE (CONTACTOS.MODULO = '+QuotedStr('CLIENTES')+') AND (CONTACTOS.CODIGO = '+QuotedStr(DBEdit1.Text)+')');
FContactos.Show;
end else ShowMessage('Debe crear y seleccionar el cliente para poder modifcar/borrar el contacto');
end;
procedure TFCLIENTES.SpeedButtonBC18Click(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Nuevo contacto ]****
//------------------------------------------------------------------------------
begin
SpeedButtonBC7Click(sender);
if DBEdit1.Text<>'' then
begin
VarSNomMod:='CLIENTES';
VarsCod:=DBEdit1.Field.Value;
FContactos.Show;
FContactos.SbNuevoClick(Sender);
FContactos.DBEdit3.SetFocus;
end else ShowMessage('Debe crear y seleccionar el cliente para poder crearle una nuevo contacto');
end;
procedure TFCLIENTES.SpeedButtonBC1Click(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************[ Modificar borrar Dirección ]****
//------------------------------------------------------------------------------
begin
SpeedButtonBC8Click(sender);
if DBEdit1.Text<>'' then
begin
VarSNomMod:='CLIENTES';
VarsCod:=DBEdit1.Field.Value;
ActIbdataset(DM.IBDBcos,'SELECT * FROM BCOS WHERE (BCOS.MODULO = '+QuotedStr('CLIENTES')+') AND (BCOS.CODIGO = '+QuotedStr(DBEdit1.Text)+')');
FBancos.Show;
end else ShowMessage('Debe crear y seleccionar el cliente para poder modificar/borrar un banco');
end;
procedure TFCLIENTES.SpeedButtonBC2Click(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************************[ Nueva Dirección ]****
//------------------------------------------------------------------------------
begin
SpeedButtonBC8Click(sender);
if DBEdit1.Text<>'' then
begin
VarSNomMod:='CLIENTES';
VarsCod:=DBEdit1.Field.Value;
FBancos.Show;
FBancos.SbNuevoClick(Sender);
FBancos.DBEdit3.SetFocus;
end else ShowMessage('Debe crear y seleccionar el cliente para poder crearle una nuevo banco');
end;
procedure TFCLIENTES.SpeedButtonBC3Click(Sender: TObject);
//------------------------------------------------------------------------------
//**********************************************************[ Página datos ]****
//------------------------------------------------------------------------------
begin
PGc.ActivePage:=DATOS;
end;
procedure TFCLIENTES.SpeedButtonBC4Click(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Página personas de contacto ]****
//------------------------------------------------------------------------------
begin
PGc.ActivePage:=PC;
ActQuery(IBQPC,'SELECT * FROM PC WHERE (PC.MODULO = '+QuotedStr('CLIENTES')+') AND (PC.CODIGO = '+QuotedStr(DBEdit1.Text)+')');
DBNavigator1.DataSource:=DSIBQPC;
end;
procedure TFCLIENTES.SpeedButtonBC5Click(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************[ Página Otros datos ]****
//------------------------------------------------------------------------------
begin
PGc.ActivePage:=OTROS;
end;
procedure TFCLIENTES.SpeedButtonBC6Click(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************[ Página direcciones ]****
//------------------------------------------------------------------------------
begin
PGc.ActivePage:=Direcciones;
ActQuery(IBQDir,'SELECT * FROM DIRECCIONES WHERE (DIRECCIONES.MODULO = '+QuotedStr('CLIENTES')+') AND (DIRECCIONES.CODIGO = '+QuotedStr(DBEdit1.Text)+')');
DBNavigator1.DataSource:=DSIBQDir;
end;
procedure TFCLIENTES.SpeedButtonBC7Click(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Página contactos ]****
//------------------------------------------------------------------------------
begin
PGc.ActivePage:=CONTACTOS;
ActQuery(IBQCont,'SELECT * FROM CONTACTOS WHERE (CONTACTOS.MODULO = '+QuotedStr('CLIENTES')+') AND (CONTACTOS.CODIGO = '+QuotedStr(DBEdit1.Text)+')');
DBNavigator1.DataSource:=DSIBQCon;
end;
procedure TFCLIENTES.SpeedButtonBC8Click(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************************[ Página bancos ]****
//------------------------------------------------------------------------------
begin
PGc.ActivePage:=BANCOS;
ActQuery(IBQBcos,'Select * From BCOS WHERE (BCOS.MODULO = '+QuotedStr('CLIENTES')+') AND (BCOS.CODIGO = '+QuotedStr(DBEdit1.Text)+')');
DBNavigator1.DataSource:=DSIBQBCOS;
end;
procedure TFCLIENTES.SpeedButtonBC9Click(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************************[ Cargar imagen ]****
//------------------------------------------------------------------------------
begin
if OpenPictureDialog1.Execute then
begin
DBImage1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;
end;
procedure TFCLIENTES.Timer1Timer(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************[ El evento del Timer ]******
//------------------------------------------------------------------------------
begin
SBBarraStatus.Panels[2].Text:=TimeToStr(now);
if SBBarraStatus.Panels[1].Text<>DateToStr(Now) then SBBarraStatus.Panels[1].Text:=DateToStr(Now);
end;
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment