Created
June 2, 2013 08:38
-
-
Save anonymous/5693046 to your computer and use it in GitHub Desktop.
Módulo de direcciones de programa de Gestión desde 0
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
unit Udirecciones; | |
{$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; | |
type | |
TFdirecciones = 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; | |
DBIBMemo1: TDBIBMemo; | |
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; | |
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 DBEdit3Exit(Sender: TObject); | |
procedure DBEdit6Exit(Sender: TObject); | |
procedure DBEdit7Exit(Sender: TObject); | |
procedure DBGNoEnableDrawColumnCell(Sender: TObject; const Rect: TRect; | |
DataCol: Integer; Column: TColumn; State: TGridDrawState); | |
private | |
{ Private declarations } | |
public | |
{ Public declarations } | |
end; | |
var | |
Fdirecciones: TFdirecciones; | |
IBT:TIBTransaction; | |
implementation | |
{$R *.dfm} | |
uses UDM,Fun, Umenu, Fun_Errores, FUN_DBGRID, Uclientes; | |
procedure TFdirecciones.BBuscarClick(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//**************************************************************[ Buscar ]****** | |
//------------------------------------------------------------------------------ | |
var Campo:string; | |
begin | |
Campo:='DIRECCION'; {Dato a rellenar por el progrmador con el nombre del campo en la busqueda} | |
DSPrincipal.DataSet.Locate(Campo,Ebusqueda.Text,[loCaseInsensitive,loPartialKey]); | |
end; | |
procedure TFdirecciones.BCerrarClick(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//*****************************************************[ Cerrar Busqueda ]****** | |
//------------------------------------------------------------------------------ | |
begin | |
BLimpiarClick(Sender); | |
GBBuscar.Visible:=False; | |
end; | |
procedure TFdirecciones.BCerrarIMPClick(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//****************************************************[ Cerrar Imrprimir ]****** | |
//------------------------------------------------------------------------------ | |
begin | |
GBImprimir.Visible:=False; | |
end; | |
procedure TFdirecciones.BLimpiarClick(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//**************************************************[ Limpia la busqueda ]****** | |
//------------------------------------------------------------------------------ | |
begin | |
Ebusqueda.Text:=''; | |
BBuscarClick(Sender); | |
Ebusqueda.SetFocus; | |
end; | |
procedure TFdirecciones.DBEdit3Exit(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//*************************************************************[ Salir de pais ]**** | |
// Si lo dejamos en blanco rellena por defecto España | |
//------------------------------------------------------------------------------ | |
begin | |
if DBEdit3.Text='' then DBEdit3.Field.Value:='España'; | |
end; | |
procedure TFdirecciones.DBEdit6Exit(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//*************************************************************[ Salir de población ]**** | |
// Si lo dejamos en blanco rellena por defecto Las Palmas | |
//------------------------------------------------------------------------------ | |
begin | |
if DBEdit6.Text='' then DBEdit6.Field.Value:='Las Palmas'; | |
end; | |
procedure TFdirecciones.DBEdit7Exit(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//*************************************************************[ Salir de provincía ]**** | |
// Si lo dejamos en blanco rellena por defecto Las Palmas de Gran Canarias | |
//------------------------------------------------------------------------------ | |
begin | |
if DBEdit7.Text='' then DBEdit7.Field.Value:='Las Palmas de Gran Canaria'; | |
end; | |
procedure TFdirecciones.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 TFdirecciones.EbusquedaChange(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//*************************************[ Mientras se escribe en busqueda ]****** | |
//------------------------------------------------------------------------------ | |
begin | |
BBuscarClick(sender); | |
end; | |
procedure TFdirecciones.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 TFdirecciones.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; | |
ActIbdataset(DM.IBDirecciones,'SELECT * FROM DIRECCIONES'); | |
//Retornos al modulo de llamada | |
if VarSNomMod='CLIENTES' then FClientes.SpeedButtonBC6Click(sender); | |
//Según se van creando los módulos de llamada ir añadiendo, ejmplo Proveedores, Agentes, Personal, etc | |
end; | |
procedure TFdirecciones.FormCreate(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//***************************************************[ Al Crearse el Fom ]****** | |
// Cosas que queremos que haga según se inicie el Form | |
//------------------------------------------------------------------------------ | |
begin | |
IBT:=UDM.DM.IBTransaction1; | |
end; | |
procedure TFdirecciones.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 TFdirecciones.SbBorrarClick(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//*******************************************[ Borrar el Actual Registro ]****** | |
//------------------------------------------------------------------------------ | |
begin //Cambiar por el mensaje elegido | |
if not DsPrincipal.DataSet.IsEmpty then | |
begin | |
if (MessageBox(0, '¿Esta seguro de eliminar el registro actual?', | |
'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 else ShowMessage('No hay registros que poder borrar'); | |
end; | |
procedure TFdirecciones.SBBuscarClick(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//******************************************************[ Abrir Busqueda ]****** | |
//------------------------------------------------------------------------------ | |
begin | |
GBBuscar.Visible:=True; | |
Ebusqueda.SetFocus; | |
end; | |
procedure TFdirecciones.SBCancelarClick(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//*****************************************************[ Cancelar Proceso]****** | |
//------------------------------------------------------------------------------ | |
begin | |
DSPrincipal.DataSet.Cancel; | |
IBT.RollbackRetaining; //Donde IBT es el nombre de su Ibtrasaction, con ruta | |
end; | |
procedure TFdirecciones.SBConfirmarClick(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//********************************************************[ Grabar datos ]****** | |
//------------------------------------------------------------------------------ | |
begin | |
try | |
if DBEdit4.Text<>'' then | |
begin | |
DSPrincipal.DataSet.Post; | |
IBT.CommitRetaining; | |
end else ShowMessage('Para poder grabar los datos, como mínimo debe poner la dirección'); | |
except | |
on E: Exception do | |
begin | |
MessageBeep(1000); | |
ShowMessage('Se ha producido un error y el proceso no se ha podido terminar Unidad:[ Udirecciones ] 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; | |
end; | |
end; | |
end; | |
procedure TFdirecciones.SBImprimirClick(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//******************************************************[ Abrir Imprimir ]****** | |
//------------------------------------------------------------------------------ | |
begin | |
GBImprimir.Visible:=True; | |
end; | |
procedure TFdirecciones.SBMas1Click(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//*************************************************[ Avanzar un registro ]****** | |
//------------------------------------------------------------------------------ | |
begin | |
DSPrincipal.DataSet.Next; | |
end; | |
procedure TFdirecciones.SBMasXClick(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//*************************************************[ Avanzar x Registros ]****** | |
//------------------------------------------------------------------------------ | |
begin | |
DSPrincipal.DataSet.MoveBy(SEMobeByX.Value); | |
end; | |
procedure TFdirecciones.SBMenos1Click(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//***********************************************[ Retroceder 1 registro ]****** | |
//------------------------------------------------------------------------------ | |
begin | |
DSPrincipal.DataSet.Prior; | |
end; | |
procedure TFdirecciones.SBMenosxClick(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//**********************************************[ Retroceder x Registros ]****** | |
//------------------------------------------------------------------------------ | |
begin | |
DSPrincipal.DataSet.MoveBy(-SEMobeByX.Value); | |
end; | |
procedure TFdirecciones.SbModificarClick(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//*******************************************[ Editar el actual registro ]****** | |
//------------------------------------------------------------------------------ | |
begin | |
if DsPrincipal.DataSet.IsEmpty<>true then | |
begin | |
DSPrincipal.DataSet.Edit; | |
DBEdit1.SetFocus; | |
end else ShowMessage('No hay tregistros disponibles para editar') | |
end; | |
procedure TFdirecciones.SbNuevoClick(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//*******************************************[ Creamos un nuevo registro ]****** | |
//------------------------------------------------------------------------------ | |
begin | |
DSPrincipal.DataSet.Insert; | |
DsPrincipal.DataSet.FieldByName('MODULO').Value:=VarSNomMod; | |
DsPrincipal.DataSet.FieldByName('CODIGO').Value:=VarsCod; | |
DBIBMemo1.Lines.Clear; | |
DBEdit3.SetFocus; | |
end; | |
procedure TFdirecciones.SBPrimeroClick(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//***********************************************[ Ir al Primer Registro ]****** | |
//------------------------------------------------------------------------------ | |
begin | |
DSPrincipal.DataSet.First; | |
end; | |
procedure TFdirecciones.SBUltimoClick(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//***********************************************[ Ir al último registro ]****** | |
//------------------------------------------------------------------------------ | |
begin | |
DSPrincipal.DataSet.Last; | |
end; | |
procedure TFdirecciones.SB_SalirClick(Sender: TObject); | |
//------------------------------------------------------------------------------ | |
//******************************************************[ Salir Del Form ]****** | |
//------------------------------------------------------------------------------ | |
begin | |
Fdirecciones.Close; | |
end; | |
procedure TFdirecciones.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