Skip to content

Instantly share code, notes, and snippets.

Created June 19, 2013 08:46
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save anonymous/5812746 to your computer and use it in GitHub Desktop.
Save anonymous/5812746 to your computer and use it in GitHub Desktop.
Módulo de proveedores del programa de Gestión desde 0
unit UProveedor;
{$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,
DBneweditjl, IBCustomDataSet, IBQuery;
//[ 1]----------------[ Para poder tener tabs del page control en color]--------
Type
TTabSheet = class(ComCtrls.TTabSheet)
private
FColor: TColor;
procedure SetColor(Value: TColor);
procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd);
message WM_ERASEBKGND;
public
constructor Create(aOwner: TComponent); override;
property Color: TColor read FColor write SetColor;
end;
//[ 1]--FIN SECCIÓN---[ Para poder tener tabs del page control en color]--------
type
TFProveedor = 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;
PC: TPageControl;
Datos: TTabSheet;
Contacto: TTabSheet;
Notas: TTabSheet;
Imagenes: TTabSheet;
NewPanelDB1: TNewPanelDB;
SBBCDatos: TSpeedButtonBC;
SPBCContacto: TSpeedButtonBC;
PCAuxiliares: TPageControl;
Auxiliares1: TTabSheet;
Auxiliares2: TTabSheet;
Panel4: TPanel;
SPBCModificarContacto: TSpeedButtonBC;
SPBCNuevoContacto: TSpeedButtonBC;
Panel5: TPanel;
Image1: TImage;
Panel6: TPanel;
SPBCModificarNota: TSpeedButtonBC;
SPBCNuevaNota: TSpeedButtonBC;
Panel7: TPanel;
Image2: TImage;
Panel8: TPanel;
SPBCModificarImagen: TSpeedButtonBC;
SPBCNuevaImagen: TSpeedButtonBC;
Panel9: TPanel;
Image3: TImage;
Panel10: TPanel;
SPBCModificaPC: TSpeedButtonBC;
SPBCNuevaPC: TSpeedButtonBC;
Panel11: TPanel;
Image4: TImage;
Panel12: TPanel;
SPBCModificaDireccion: TSpeedButtonBC;
SPBCNuevaDireccion: TSpeedButtonBC;
Panel13: TPanel;
Image5: TImage;
Panel14: TPanel;
SPBCModificarBanco: TSpeedButtonBC;
SPBCNuevoBanco: TSpeedButtonBC;
Panel15: TPanel;
Image6: TImage;
SPBCNOtas: TSpeedButtonBC;
SPBCImagenes: TSpeedButtonBC;
SPBCPersonaContacto: TSpeedButtonBC;
SPBCDirecciones: TSpeedButtonBC;
SPBCBancos: TSpeedButtonBC;
SPBCCompras: TSpeedButtonBC;
PersonaContacto: TTabSheet;
Direcciones: TTabSheet;
Bancos: TTabSheet;
Compras: TTabSheet;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
DBNCodigo: TDBNewEditJL;
DBNFechaAlta: TDBNewEditJL;
DBNEmpresa: TDBNewEditJL;
DBNCodigoFormaPago: TDBNewEditJL;
DBNCIF: TDBNewEditJL;
DBNDiasPago: TDBNewEditJL;
SPBCNuevaFP: TSpeedButtonBC;
SPBCBuscarFP: TSpeedButtonBC;
Label7: TLabel;
Label8: TLabel;
DBGrid1: TDBGrid;
DBEdit1: TDBEdit;
DBEdit2: TDBEdit;
DBIBMemo1: TDBIBMemo;
Label9: TLabel;
Label10: TLabel;
DBEdit3: TDBEdit;
DBIBMemo2: TDBIBMemo;
DBGrid2: TDBGrid;
DBEdit4: TDBEdit;
DBImage1: TDBImage;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Label15: TLabel;
Label16: TLabel;
Label17: TLabel;
Label18: TLabel;
Label19: TLabel;
DBEdit5: TDBEdit;
DBEdit6: TDBEdit;
DBIBMemo3: TDBIBMemo;
DBGrid3: TDBGrid;
DBEdit7: TDBEdit;
DBEdit8: TDBEdit;
DBEdit9: TDBEdit;
DBEdit10: TDBEdit;
DBEdit11: TDBEdit;
DBEdit12: TDBEdit;
DBNavigator1: TDBNavigator;
Label20: TLabel;
Label21: TLabel;
Label22: TLabel;
Label23: TLabel;
Label24: TLabel;
Label25: TLabel;
DBGrid4: TDBGrid;
DBEdit13: TDBEdit;
DBEdit14: TDBEdit;
DBEdit15: TDBEdit;
DBEdit16: TDBEdit;
DBEdit17: TDBEdit;
DBEdit18: TDBEdit;
Label26: TLabel;
Label27: TLabel;
Label28: TLabel;
Label29: TLabel;
DBNewEditJL1: TDBNewEditJL;
DBNewEditJL2: TDBNewEditJL;
DBNewEditJL3: TDBNewEditJL;
DBImage2: TDBImage;
Label30: TLabel;
Label31: TLabel;
Label32: TLabel;
Label33: TLabel;
DBNewEditJL4: TDBNewEditJL;
DBNewEditJL5: TDBNewEditJL;
DBNewEditJL6: TDBNewEditJL;
DBIBMemo4: TDBIBMemo;
DBGrid5: TDBGrid;
DBGrid6: TDBGrid;
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 PCDrawTab(Control: TCustomTabControl; TabIndex: Integer;
const Rect: TRect; Active: Boolean);
procedure SPBCNuevaFPClick(Sender: TObject);
procedure SPBCBuscarFPClick(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure SPBCNuevaNotaClick(Sender: TObject);
procedure CargaDatos(Tipo:Integer;Nuevo:Boolean;Nombre:string;Sender: TObject);
procedure SPBCModificarNotaClick(Sender: TObject);
procedure SPBCNuevoContactoClick(Sender: TObject);
procedure SPBCModificarContactoClick(Sender: TObject);
procedure SPBCNuevaImagenClick(Sender: TObject);
procedure SPBCModificarImagenClick(Sender: TObject);
procedure SPBCNuevaPCClick(Sender: TObject);
procedure SPBCModificaPCClick(Sender: TObject);
procedure SPBCNuevaDireccionClick(Sender: TObject);
procedure SPBCModificaDireccionClick(Sender: TObject);
procedure SPBCNuevoBancoClick(Sender: TObject);
procedure SPBCModificarBancoClick(Sender: TObject);
procedure CambiarPagina(index:Integer;Sender:TObject);
procedure SBBCDatosClick(Sender: TObject);
procedure SPBCContactoClick(Sender: TObject);
procedure SPBCNOtasClick(Sender: TObject);
procedure SPBCImagenesClick(Sender: TObject);
procedure SPBCPersonaContactoClick(Sender: TObject);
procedure SPBCDireccionesClick(Sender: TObject);
procedure SPBCBancosClick(Sender: TObject);
procedure SPBCComprasClick(Sender: TObject);
procedure DBGNoEnableDrawColumnCell(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 DBGrid2DrawColumnCell(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 DBGrid4DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure DBGrid5DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure DBGrid6DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FProveedor: TFProveedor;
IBT:TIBTransaction;
implementation
{$R *.dfm}
uses UDM,UMENU,Fun,FUN_DBGRID,UNotas,UImagenes,UPC,UContactos,Udirecciones,UBancos, UbusquedaFP, UFormasdePago;
//[ 2]----------------[ Para poder tener tabs del page control en color]--------
constructor TTabSheet.Create(aOwner: TComponent);
//------------------------------------------------------------------------------
//*************************************[ Crear nueva propiedad tabsheet ]*******
//------------------------------------------------------------------------------
begin
inherited;
FColor := clBtnFace;
end;
//[ 2]--FIN SECCIÓN---[ Para poder tener tabs del page control en color]--------
//[ 3]----------------[ Para poder tener tabs del page control en color]--------
procedure TTabSheet.SetColor(Value: TColor);
//------------------------------------------------------------------------------
//**************************************************[ Seleción de color ]*******
//------------------------------------------------------------------------------
begin
if FColor <> Value then
begin
FColor := Value;
Invalidate;
end;
end;
//[ 3]--FIN SECCIÓN---[ Para poder tener tabs del page control en color]--------
//[ 4]----------------[ Para poder tener tabs del page control en color]--------
procedure TTabSheet.WMEraseBkGnd(var Msg: TWMEraseBkGnd);
//------------------------------------------------------------------------------
//******************************************[ Dibujar en el pagecontrol ]*******
//------------------------------------------------------------------------------
begin
if FColor = clBtnFace then
inherited
else
begin
Brush.Color := FColor;
Windows.FillRect(Msg.dc, ClientRect, Brush.Handle);
Msg.Result := 1;
end;
end;
//[ 4]--FIN SECCIÓN---[ Para poder tener tabs del page control en color]--------
procedure TFProveedor.BBuscarClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ Buscar ]******
//------------------------------------------------------------------------------
var Campo:string;
begin
Campo:=''; {Dato a rellenar por el progrmador con el nombre del campo en la busqueda}
DSPrincipal.DataSet.Locate(Campo,Ebusqueda.Text,[loCaseInsensitive,loPartialKey]);
end;
procedure TFProveedor.BCerrarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Cerrar Busqueda ]******
//------------------------------------------------------------------------------
begin
BLimpiarClick(Sender);
GBBuscar.Visible:=False;
end;
procedure TFProveedor.BCerrarIMPClick(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************[ Cerrar Imrprimir ]******
//------------------------------------------------------------------------------
begin
GBImprimir.Visible:=False;
end;
procedure TFProveedor.BLimpiarClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************[ Limpia la busqueda ]******
//------------------------------------------------------------------------------
begin
Ebusqueda.Text:='';
BBuscarClick(Sender);
Ebusqueda.SetFocus;
end;
procedure TFProveedor.CambiarPagina(index: Integer; Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Cambiar Página ]****
// Al pulsar los botones para acceder a las pestañas
//------------------------------------------------------------------------------
var VarBActivar:Boolean;
VarISegundoPageControlIndex:Integer;
VarSModulo, VarSCodigo:string;
begin
VarBActivar:=true;
VarISegundoPageControlIndex:=0;
VarSModulo:='PROVEEDORES';
VarSCodigo:=DBNCodigo.Text;
case index of
0:begin //Datos
VarBActivar:=False;
end;
1:begin //Contacto
ActQuery(DM.IBQContactos,'SELECT * FROM CONTACTOS WHERE (CONTACTOS.MODULO = '+QuotedStr(VarSModulo)+') AND (CONTACTOS.CODIGO = '+QuotedStr(VarSCodigo)+')');
if not DM.IBQContactos.IsEmpty then
begin
DBNavigator1.DataSource:=DM.DSIBQContactos;
end else DM.IBQContactos.Active:=False;
end;
2:begin //Notas
ActQuery(DM.IBQNOTAS,'SELECT * FROM NOTAS WHERE (NOTAS.NOMBREMODULO = '+QuotedStr(VarSModulo)+') AND (NOTAS.CODIGO = '+QuotedStr(VarSCodigo)+')');
if not DM.IBQNOTAS.IsEmpty then
begin
DBNavigator1.DataSource:=DM.DSNotas;
//Gride de notas
TStringGrid(DBGrid5).DefaultRowHeight :=40; //Debe cambiarse el Grid
TStringGrid(DBGrid5).RowHeights[0]:=20; //Debe cambiarse el Grid
end else DM.IBQNOTAS.Active:=False;
end;
3:begin //Imagenes
ActQuery(DM.IBQIMAGENES,'SELECT * FROM IMAGENES WHERE (IMAGENES.NOMBREMODULO = '+QuotedStr(VarSModulo)+') AND (IMAGENES.CODIGO = '+QuotedStr(VarSCodigo)+')');
if not DM.IBQIMAGENES.IsEmpty then
begin
DBNavigator1.DataSource:=DM.DSImagenes;
//Gride de imagenes
TStringGrid(DBGrid6).DefaultRowHeight :=50; //Debe cambiarse el Grid
TStringGrid(DBGrid6).RowHeights[0]:=20; //Debe cambiarse el Grid
end else DM.IBQIMAGENES.Active:=False;
end;
4:begin //personas de contacto
ActQuery(DM.IBQPersonasContacto,'SELECT * FROM PC WHERE (PC.MODULO = '+QuotedStr(VarSModulo)+') AND (PC.CODIGO = '+QuotedStr(VarSCodigo)+')');
if not DM.IBQPersonasContacto.IsEmpty then
begin
DBNavigator1.DataSource:=DM.DSIBQPersonasContacto;
end else DM.IBQPersonasContacto.Active:=False;
VarISegundoPageControlIndex:=1;
end;
5:begin //Direcciones
ActQuery(DM.IBQDirecciones,'SELECT * FROM DIRECCIONES WHERE (DIRECCIONES.MODULO = '+QuotedStr(VarSModulo)+') AND (DIRECCIONES.CODIGO = '+QuotedStr(VarSCodigo)+')');
if not DM.IBQDirecciones.IsEmpty then
begin
DBNavigator1.DataSource:=DM.DSIBQDirecciones;
end else DM.IBQDirecciones.Active:=False;
VarISegundoPageControlIndex:=1;
end;
6:begin //BAncos
ActQuery(DM.IBQBancos,'Select * From BCOS WHERE (BCOS.MODULO = '+QuotedStr(VarSModulo)+') AND (BCOS.CODIGO = '+QuotedStr(VarSCodigo)+')');
if not DM.IBQBancos.IsEmpty then
begin
DBNavigator1.DataSource:=DM.DSIBQBancos;
end else DM.IBQBancos.Active:=False;
VarISegundoPageControlIndex:=1;
end;
7:begin //Compras
//Aqui activaremos el dbnavigator a un querry para movernos sobre las compras al proveedor
VarISegundoPageControlIndex:=1;
end;
end;
DBNavigator1.Enabled:=VarBActivar;
PCAuxiliares.ActivePageIndex:=VarISegundoPageControlIndex;
PC.ActivePageIndex:=index;
end;
procedure TFProveedor.CargaDatos(Tipo:Integer;Nuevo:Boolean;Nombre:string;Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Carga datos ]****
// Datos Comunes (la idea es la carga de datos comunes
//------------------------------------------------------------------------------
var VarSModulo, VarSModulo2, VarSCodigo:string;
begin
VarSModulo:='PROVEEDORES';
VarSCodigo:=DBNCodigo.Text;
VarSModulo2:='el proveedor'; //Como reutilizamos el código para sólo tener que cambiar aquí el módulo
if DBNCodigo.Text<>'' then
begin
VarSNomMod:=VarSModulo;
VarsCod:=DBNCodigo.Field.Value;
case Tipo of
0:begin //Contacto
SPBCContactoClick(sender);
FContactos.Show;
if Nuevo=false then
begin
ActIbdataset(DM.IBDContacto,'SELECT * FROM CONTACTOS WHERE (CONTACTOS.MODULO = '+QuotedStr(VarSModulo)+') AND (CONTACTOS.CODIGO = '+QuotedStr(VarSCodigo)+')');
end else
begin
FContactos.SbNuevoClick(Sender);
FContactos.DBEdit3.SetFocus;
end;
end;
1:begin //Notas
SPBCNOtasClick(sender);
FNotas.Show;
if Nuevo=false then
begin
ActIbdataset(DM.IBDNOTAS,'SELECT * FROM NOTAS WHERE (NOTAS.NOMBREMODULO = '+QuotedStr(VarSModulo)+') AND (NOTAS.CODIGO = '+QuotedStr(VarSCodigo)+')');
end else
begin
Fnotas.SbNuevoClick(Sender);
Fnotas.DBNewEditJL3.SetFocus;
end;
end;
2:begin //Imagenes
SPBCImagenesClick(sender);
FImagenes.Show;
if Nuevo=false then
begin
ActIbdataset(DM.IBDIMAGENES,'SELECT * FROM IMAGENES WHERE (IMAGENES.NOMBREMODULO = '+QuotedStr(VarSModulo)+') AND (IMAGENES.CODIGO = '+QuotedStr(VarSCodigo)+')');
end else
begin
Fimagenes.SbNuevoClick(Sender);
Fimagenes.DBNewEditJL3.SetFocus;
end;
end;
3:begin //Personas de Contacto
SPBCPersonaContactoClick(sender);
FPC.Show;
if Nuevo=false then
begin
ActIbdataset(DM.IBDPC,'SELECT * FROM CONTACTOS WHERE (CONTACTOS.MODULO = '+QuotedStr(VarSModulo)+') AND (CONTACTOS.CODIGO = '+QuotedStr(VarSCodigo)+')');
end else
begin
FPC.SbNuevoClick(Sender);
FPC.DBEdit3.SetFocus;
end;
end;
4:begin //Direcciones
SPBCDireccionesClick(sender);
Fdirecciones.Show;
if Nuevo=false then
begin
ActIbdataset(DM.IBDirecciones,'SELECT * FROM DIRECCIONES WHERE (DIRECCIONES.MODULO = '+QuotedStr(VarSModulo)+') AND (DIRECCIONES.CODIGO = '+QuotedStr(VarSCodigo)+')');
end else
begin
Fdirecciones.SbNuevoClick(Sender);
Fdirecciones.DBEdit3.SetFocus;
end;
end;
5:begin //Banco
SPBCBancosClick(sender);
FBancos.Show;
if Nuevo=false then
begin
ActIbdataset(DM.IBDBcos,'SELECT * FROM BCOS WHERE (BCOS.MODULO = '+QuotedStr(VarSModulo)+') AND (BCOS.CODIGO = '+QuotedStr(VarSCodigo)+')');
end else
begin
FBancos.SbNuevoClick(Sender);
FBancos.DBEdit3.SetFocus;
end;
end;
end;
end else
begin
if Nuevo then ShowMessage('Debe crear y seleccionar '+VarSModulo2+' para poder crearle una nuevo/a '+Nombre)
else ShowMessage('Debe crear y seleccionar '+VarSModulo2+' para poder modificar/borrar el/la '+Nombre);
end;
end;
procedure TFProveedor.DBGNoEnableDrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
//------------------------------------------------------------------------------
//*******************************************************[ ZEbaro del Grid ]****
//------------------------------------------------------------------------------
begin
Zebrado(DsPrincipal,DBGNoEnable, Rect, Column, State, COLOR1GRID,COLOR2GRID);
end;
procedure TFProveedor.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
//------------------------------------------------------------------------------
//*******************************************************[ ZEbaro del Grid ]****
//------------------------------------------------------------------------------
begin
Zebrado(DM.DSIBQDirecciones,DBGrid1, Rect, Column, State, COLOR1GRID,COLOR2GRID);
end;
procedure TFProveedor.DBGrid2DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
//------------------------------------------------------------------------------
//*******************************************************[ ZEbaro del Grid ]****
//------------------------------------------------------------------------------
begin
Zebrado(DM.DSIBQPersonasContacto,DBGrid2, Rect, Column, State, COLOR1GRID,COLOR2GRID);
end;
procedure TFProveedor.DBGrid3DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
//------------------------------------------------------------------------------
//*******************************************************[ ZEbaro del Grid ]****
//------------------------------------------------------------------------------
begin
Zebrado(DM.DSIBQContactos,DBGrid3, Rect, Column, State, COLOR1GRID,COLOR2GRID);
end;
procedure TFProveedor.DBGrid4DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
//------------------------------------------------------------------------------
//*******************************************************[ ZEbaro del Grid ]****
//------------------------------------------------------------------------------
begin
Zebrado(DM.DSIBQBancos,DBGrid4, Rect, Column, State, COLOR1GRID,COLOR2GRID);
end;
procedure TFProveedor.DBGrid5DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
//------------------------------------------------------------------------------
//*******************************************************[ ZEbaro del Grid ]****
//------------------------------------------------------------------------------
begin
Zebrado(DM.DSNotas,DBGrid5, Rect, Column, State, COLOR1GRID,COLOR2GRID);
MemoGridB(DBGrid5,DM.DSNotas.DataSet.FieldByName('NOTAS'), Rect, Column, State);
end;
procedure TFProveedor.DBGrid6DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
//------------------------------------------------------------------------------
//*******************************************************[ ZEbaro del Grid ]****
//------------------------------------------------------------------------------
begin
Zebrado(DM.DSImagenes,DBGrid6, Rect, Column, State, COLOR1GRID,COLOR2GRID);
GridImagen(DBGrid6, DM.DSImagenes.DataSet.Fields.FieldByName('IMAGENES'), Rect,Column,State);
end;
procedure TFProveedor.EbusquedaChange(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************[ Mientras se escribe en busqueda ]******
//------------------------------------------------------------------------------
begin
BBuscarClick(sender);
end;
procedure TFProveedor.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 TFProveedor.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;
end;
procedure TFProveedor.FormCreate(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************[ Al Crearse el Fom ]******
// Cosas que queremos que haga según se inicie el Form
//------------------------------------------------------------------------------
begin
IBT:=DM.IBTransaction1; // Aquí especificar el modulo y el IBTransaction a usar
//[ 5]----------------------------[ Tabs de page control en color ]-------------
Datos.Color:=clMoneyGreen; //verde pastel
Contacto.Color:=clSkyBlue; //Azul Pastel
Notas.Color:=clInfoBk; //Amarillo pastel
Imagenes.Color:=$0099CCFF; //Color naranja
PersonaContacto.Color:=$00FF99CC;
Direcciones.Color:=$00CCCC66;
Bancos.Color:=$006699FF;
Compras.Color:=$00CCCCFF;
//[ 5]----------------------------[ Tabs de page control en color ]-------------
{Cosas que queremos que haga según se inicie el Form}
PC.ActivePageIndex:=0;
PCAuxiliares.ActivePageIndex:=0;
end;
procedure TFProveedor.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
//------------------------------------------------------------------------------
//***************************************************************[ KeyDown ]****
// Asiganemos teclas
//------------------------------------------------------------------------------
begin
if (FProveedor.Active) and (DsPrincipal.DataSet.State in [dsEdit,dsInsert]) then //Sólo si estamos editando o insertando
begin
if ( Shift = [ ssalt ] ) and ( Key = 78 ) then SPBCNuevaFPClick(Sender); //Nueva forma de pago
if ( Shift = [ ssalt ] ) and ( Key = 66 ) then SPBCBuscarFPClick(Sender); //Buscar Forma de pago
end;
end;
procedure TFProveedor.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 TFProveedor.PCDrawTab(Control: TCustomTabControl;
TabIndex: Integer; const Rect: TRect; Active: Boolean);
//------------------------------------------------------------------------------
//************************************************[ COLORES PAGECONTROL ]*******
//------------------------------------------------------------------------------
var
//[ 6]----------------[ Para poder tener tabs del page control en color]--------
AText: string;
APoint: TPoint;
//[ 6]--FIN SECCIÓN---[ Para poder tener tabs del page control en color]--------
begin
//[ 7]----------------[ Para poder tener tabs del page control en color]--------
with (Control as TPageControl).Canvas do
begin
case TabIndex of
0: brush.Color:=clMoneyGreen;
1: brush.Color:=clSkyBlue;
2: brush.Color:=clInfoBk;
3: Brush.Color:=$0099CCFF;
4: Brush.Color:=$00FF99CC;
5: Brush.Color:=$00CCCC66;
6: Brush.Color:=$006699FF;
7: Brush.Color:=$00CCCCFF;
end;
PC.Canvas.Rectangle(Rect);
PC.Canvas.Brush.Color:=Control.Canvas.Brush.Color;
PC.Pages[TabIndex].brush.Color := Control.Canvas.brush.Color;
PC.Pages[TabIndex].Repaint;
FillRect(Rect);
AText := TPageControl(Control).Pages[TabIndex].Caption;
with Control.Canvas do
begin
APoint.x := (Rect.Right - Rect.Left) div 2 - TextWidth(AText) div 2;
APoint.y := (Rect.Bottom - Rect.Top) div 2 - TextHeight(AText) div 2;
TextRect(Rect, Rect.Left + APoint.x, Rect.Top + APoint.y, AText);
end;
end;
//[ 7]--FIN SECCIÓN---[ Para poder tener tabs del page control en color]--------
end;
procedure TFProveedor.SBBCDatosClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************************[ Datos ]****
//------------------------------------------------------------------------------
begin
CambiarPagina(0,Sender);
end;
procedure TFProveedor.SbBorrarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Borrar el Actual Registro ]******
//------------------------------------------------------------------------------
begin //Cambiar por el mensaje elegido
if (MessageBox(0, '¿Esta seguro de eliminar el registro actual?', //Aqui no se porque me manda la última comilla simple y la coma a la linea de abajo, por favor subir al final de la linea anterior
'Eliminar Registro', MB_ICONSTOP or MB_YESNO or MB_DEFBUTTON2) = ID_No) then abort
else begin
DSPrincipal.DataSet.Delete;
ShowMessage('El registro ha sido eliminado');
IBT.CommitRetaining;
end;
end;
procedure TFProveedor.SBBuscarClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Abrir Busqueda ]******
//------------------------------------------------------------------------------
begin
GBBuscar.Visible:=True;
Ebusqueda.SetFocus;
end;
procedure TFProveedor.SBCancelarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Cancelar Proceso]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Cancel;
IBT.RollbackRetaining; //Donde IBT es el nombre de su Ibtrasaction, con ruta
end;
procedure TFProveedor.SBConfirmarClick(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Grabar datos ]******
//------------------------------------------------------------------------------
begin
try
if (DBNCodigo.Text<>'') and (DBNEmpresa.Text<>'') then
begin
DSPrincipal.DataSet.Post;
IBT.CommitRetaining; //Donde IBT es el nombre de su Ibtrasaction, con ruta
end else ShowMessage('Debe rellenar cómo mínimo el código y el nombre de la emoresa, para poder grabar');
except
on E: Exception do
begin
MessageBeep(1000);
ShowMessage('Se ha producido un error y el proceso no se ha podido terminar Unidad:[ UProveedor ] 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');
DSPrincipal.DataSet.Cancel;
IBT.RollbackRetaining; //Donde IBT es el nombre de su Ibtrasaction, con ruta
end;
end;
end;
procedure TFProveedor.SBImprimirClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Abrir Imprimir ]******
//------------------------------------------------------------------------------
begin
GBImprimir.Visible:=True;
end;
procedure TFProveedor.SBMas1Click(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************[ Avanzar un registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Next;
end;
procedure TFProveedor.SBMasXClick(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************[ Avanzar x Registros ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.MoveBy(SEMobeByX.Value);
end;
procedure TFProveedor.SBMenos1Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Retroceder 1 registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Prior;
end;
procedure TFProveedor.SBMenosxClick(Sender: TObject);
//------------------------------------------------------------------------------
//**********************************************[ Retroceder x Registros ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.MoveBy(-SEMobeByX.Value);
end;
procedure TFProveedor.SbModificarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Editar el actual registro ]******
//------------------------------------------------------------------------------
begin
if DsPrincipal.DataSet.IsEmpty<>true then
begin
DSPrincipal.DataSet.Edit;
DBNCodigo.SetFocus;
end else ShowMessage('No hay tregistros disponibles para editar')
end;
procedure TFProveedor.SbNuevoClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Creamos un nuevo registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Insert;
DBNCodigo.SetFocus;
end;
procedure TFProveedor.SBPrimeroClick(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Ir al Primer Registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.First;
end;
procedure TFProveedor.SBUltimoClick(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Ir al último registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Last;
end;
procedure TFProveedor.SB_SalirClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Salir Del Form ]******
//------------------------------------------------------------------------------
begin
FProveedor.Close;
end;
procedure TFProveedor.SPBCNOtasClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************************[ Notas ]****
//------------------------------------------------------------------------------
begin
CambiarPagina(2,Sender);
end;
procedure TFProveedor.SPBCNuevaDireccionClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************************[ Nueva Dirección ]****
//------------------------------------------------------------------------------
begin
CargaDatos(4,True,'Dirección',Sender);
end;
procedure TFProveedor.SPBCNuevaFPClick(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************[ Nuevo forma de pago ]****
// Puede ser llamado mediante click o pulsación de teclas ALT + N
//------------------------------------------------------------------------------
begin
FFormasdePago.Show;
VarSNomMod:='PROVEEDORES';
end;
procedure TFProveedor.SPBCNuevaImagenClick(Sender: TObject);
//------------------------------------------------------------------------------
//**********************************************************[ Nueva Imagen ]****
//------------------------------------------------------------------------------
begin
CargaDatos(2,True,'Imagen',Sender);
end;
procedure TFProveedor.SPBCModificaDireccionClick(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************[ Modificar Dirección ]****
//------------------------------------------------------------------------------
begin
CargaDatos(4,False,'Dirección',Sender);
end;
procedure TFProveedor.SPBCModificaPCClick(Sender: TObject);
//------------------------------------------------------------------------------
//**********************************************************[ Modificar PC ]****
//------------------------------------------------------------------------------
begin
CargaDatos(3,false,'Persona de contacto',Sender);
end;
procedure TFProveedor.SPBCModificarBancoClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************************[ Modificar Banco ]****
//------------------------------------------------------------------------------
begin
CargaDatos(5,False,'Banco',Sender);
end;
procedure TFProveedor.SPBCModificarContactoClick(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************[ Modificar Contacto ]****
//------------------------------------------------------------------------------
begin
CargaDatos(0,False,'Contacto',Sender);
end;
procedure TFProveedor.SPBCModificarImagenClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Modificar Imagen ]****
//------------------------------------------------------------------------------
begin
CargaDatos(2,False,'Imagen',Sender);
end;
procedure TFProveedor.SPBCNuevoBancoClick(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Nuevo Banco ]****
//------------------------------------------------------------------------------
begin
CargaDatos(5,True,'Banco',Sender);
end;
procedure TFProveedor.SPBCNuevoContactoClick(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Nuevo Contacto ]****
//------------------------------------------------------------------------------
begin
CargaDatos(0,True,'Contacto',Sender);
end;
procedure TFProveedor.SPBCPersonaContactoClick(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************[ Persona de contacto ]****
//------------------------------------------------------------------------------
begin
CambiarPagina(4,Sender);
end;
procedure TFProveedor.SPBCModificarNotaClick(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Modificar Nota ]****
//------------------------------------------------------------------------------
begin
CargaDatos(1,False,'Nota',Sender);
end;
procedure TFProveedor.SPBCNuevaNotaClick(Sender: TObject);
//------------------------------------------------------------------------------
//************************************************************[ Nueva Nota ]****
//------------------------------------------------------------------------------
begin
CargaDatos(1,True,'Nota',Sender);
end;
procedure TFProveedor.SPBCNuevaPCClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ Nueva PC ]****
//------------------------------------------------------------------------------
begin
CargaDatos(3,True,'Persona de contacto',Sender);
end;
procedure TFProveedor.SPBCBancosClick(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************************[ Bancos ]****
//------------------------------------------------------------------------------
begin
CambiarPagina(6,Sender);
end;
procedure TFProveedor.SPBCBuscarFPClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************[ Buscar forma de pago ]****
// Puede ser llamado mediante click o pulsación de teclas ALT + b
//------------------------------------------------------------------------------
begin
VarSTabla:='FPAGOS'; //Pertenece al formularios UFbusquedaFP
VarSNomMod:='PROVEEDORES'; //Desde que modulo lo llamamos
FbusquedaFP.Show;
end;
procedure TFProveedor.SPBCComprasClick(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************************[ Compras ]****
//------------------------------------------------------------------------------
begin
CambiarPagina(7,Sender);
end;
procedure TFProveedor.SPBCContactoClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ contacto ]****
//------------------------------------------------------------------------------
begin
CambiarPagina(1,Sender);
end;
procedure TFProveedor.SPBCDireccionesClick(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************************[ Direcciones ]****
//------------------------------------------------------------------------------
begin
CambiarPagina(5,Sender);
end;
procedure TFProveedor.SPBCImagenesClick(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************************[ Imagen ]****
//------------------------------------------------------------------------------
begin
CambiarPagina(3,Sender);
end;
procedure TFProveedor.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