Skip to content

Instantly share code, notes, and snippets.

/gist:5939351

Created July 6, 2013 09:18
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/5939351 to your computer and use it in GitHub Desktop.
Save anonymous/5939351 to your computer and use it in GitHub Desktop.
Download ZIP
Regular Stocks para el tutorial de programa de gestión desde 0
Raw
gistfile1.txt
unit URegulaStock;
{$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;
type
TFRegulaStock = 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;
DBNRSCódigo: TDBNewEditJL;
DBNRSLote: TDBNewEditJL;
DBNRSFecha: TDBNewEditJL;
DBNRSCaduco: TDBNewEditJL;
DBNRSCantidad: TDBNewEditJL;
DBNRSExistencias: TDBNewEditJL;
DBIBCheckbox1: TDBIBCheckbox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label6: TLabel;
Label7: TLabel;
Panel4: TPanel;
DBGrid1: TDBGrid;
CheckRSDatosActivo: TCheckBox;
CheckRSDetalleActivo: TCheckBox;
IBQDetalle: TIBQuery;
DSIBQDetalle: TDataSource;
DBNavigator1: TDBNavigator;
Panel5: TPanel;
IBQSUMA: TIBQuery;
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 CheckRSDatosActivoClick(Sender: TObject);
procedure actualizar;
procedure DSPrincipalDataChange(Sender: TObject; Field: TField);
procedure DBNRSCódigoChange(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);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FRegulaStock: TFRegulaStock;
IBT:TIBTransaction;
implementation
{$R *.dfm}
uses UMENU,UDM, Fun,FUN_DBGRID;
procedure TFRegulaStock.actualizar;
//------------------------------------------------------------------------------
//************************************************************[ Actualizar ]****
// Nos muestra segúin nuestra elección el Stock con el mismo código
//------------------------------------------------------------------------------
begin
Panel4.Caption:='Productos con el código [ '+DBNRSCódigo.Text+' ]';
if CheckRSDetalleActivo.Checked then
begin
ActQuery(IBQDetalle,'SELECT * FROM STOCK WHERE ((STOCK.ACTIVO = '+QuotedStr('S')+
') OR (STOCK.ACTIVO IS NULL)) AND (STOCK.EXISTENCIAS > 0) AND (STOCK.CODIGOPRODUCTO = '+
QuotedStr(DBNRSCódigo.Text)+')');
ActQuery(IBQSUMA,'SELECT SUM(STOCK.EXISTENCIAS) AS FIELD_1 FROM STOCK WHERE ((STOCK.ACTIVO = '+QuotedStr('S')+
') OR (STOCK.ACTIVO IS NULL)) AND (STOCK.EXISTENCIAS > 0) AND (STOCK.CODIGOPRODUCTO = '+
QuotedStr(DBNRSCódigo.Text)+') ');
end else
begin
ActQuery(IBQDetalle,'SELECT * FROM STOCK WHERE (STOCK.CODIGOPRODUCTO = '+QuotedStr(DBNRSCódigo.Text)+')');
ActQuery(IBQSUMA,'SELECT SUM(STOCK.EXISTENCIAS) AS FIELD_1 FROM STOCK WHERE (STOCK.CODIGOPRODUCTO = '+
QuotedStr(DBNRSCódigo.Text)+') ');
end;
Panel5.caption:='Existencias [ '+IBQSUMA.FieldByName('FIELD_1').AsString+' ]';// Suma
end;
procedure TFRegulaStock.BBuscarClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ Buscar ]******
//------------------------------------------------------------------------------
var Campo:string;
begin
Campo:='LOTE'; {Dato a rellenar por el progrmador con el nombre del campo en la busqueda}
DSPrincipal.DataSet.Locate(Campo,Ebusqueda.Text,[loCaseInsensitive,loPartialKey]);
end;
procedure TFRegulaStock.BCerrarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Cerrar Busqueda ]******
//------------------------------------------------------------------------------
begin
BLimpiarClick(Sender);
GBBuscar.Visible:=False;
end;
procedure TFRegulaStock.BCerrarIMPClick(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************[ Cerrar Imrprimir ]******
//------------------------------------------------------------------------------
begin
GBImprimir.Visible:=False;
end;
procedure TFRegulaStock.BLimpiarClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************[ Limpia la busqueda ]******
//------------------------------------------------------------------------------
begin
Ebusqueda.Text:='';
BBuscarClick(Sender);
Ebusqueda.SetFocus;
end;
procedure TFRegulaStock.CheckRSDatosActivoClick(Sender: TObject);
//------------------------------------------------------------------------------
//**********************************************************[ Sólo activos ]****
// Elegimos si queremos ver toda la tabla o sólo los que están activos
//------------------------------------------------------------------------------
begin
if not (DsPrincipal.DataSet.State in [dsEdit,dsInsert]) then
begin
if CheckRSDatosActivo.Checked then ActIbdataset(DM.IBDSTOCK,'select * from STOCK WHERE ((STOCK.ACTIVO = '+QuotedStr('S')+') OR (STOCK.ACTIVO IS NULL)) AND (STOCK.EXISTENCIAS > 0)')
else ActIbdataset(DM.IBDSTOCK,'select * from STOCK');
end;
end;
procedure TFRegulaStock.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 TFRegulaStock.DBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
//------------------------------------------------------------------------------
//*******************************************************[ ZEbaro del Grid ]****
//------------------------------------------------------------------------------
begin
Zebrado(DSIBQDetalle,DBGrid1, Rect, Column, State, COLOR1GRID,COLOR2GRID);
end;
procedure TFRegulaStock.DBNRSCódigoChange(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************[ Cambiamos de código ]****
// al cambiar el código
//------------------------------------------------------------------------------
begin
if FRegulaStock.Active then
begin
if not (DsPrincipal.DataSet.State in [dsEdit, dsInsert]) then actualizar;
end;
end;
procedure TFRegulaStock.DSPrincipalDataChange(Sender: TObject; Field: TField);
//------------------------------------------------------------------------------
//****************************************************[ DSPrincipal change ]****
// Cambiamos de dato
//------------------------------------------------------------------------------
begin
if FRegulaStock.Active then
begin
if not (DsPrincipal.DataSet.State in [dsEdit, dsInsert]) then actualizar;
end;
end;
procedure TFRegulaStock.EbusquedaChange(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************[ Mientras se escribe en busqueda ]******
//------------------------------------------------------------------------------
begin
BBuscarClick(sender);
end;
procedure TFRegulaStock.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;
actualizar;
end;
procedure TFRegulaStock.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(IBQDetalle);
QuerryOC(IBQSUMA);
end;
procedure TFRegulaStock.FormCreate(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************[ Al Crearse el Fom ]******
// Cosas que queremos que haga según se inicie el Form
//------------------------------------------------------------------------------
begin
IBT:=DM.IBTransaction1;
{Cosas que queremos que haga según se inicie el Form}
end;
procedure TFRegulaStock.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 TFRegulaStock.SbBorrarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Borrar el Actual Registro ]******
//------------------------------------------------------------------------------
begin //Cambiar por el mensaje elegido
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;
procedure TFRegulaStock.SBBuscarClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Abrir Busqueda ]******
//------------------------------------------------------------------------------
begin
GBBuscar.Visible:=True;
Ebusqueda.SetFocus;
end;
procedure TFRegulaStock.SBCancelarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Cancelar Proceso]******
//------------------------------------------------------------------------------
begin
if DsPrincipal.DataSet.State in [dsEdit,dsInsert] then
DSPrincipal.DataSet.Cancel;
IBT.RollbackRetaining; //Donde IBT es el nombre de su Ibtrasaction, con ruta
end;
procedure TFRegulaStock.SBConfirmarClick(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Grabar datos ]******
//------------------------------------------------------------------------------
begin
try
if DBNRSExistencias.Text<>DBNRSExistencias.Field.AsString then DBNRSExistencias.Field.Value:=DBNRSExistencias.Text;
//Al no tener salvo un campo debemos comprobar si existen cambios y forzar su valor.
if DsPrincipal.DataSet.Modified then //Os lo pongo para que lo conoscais, comprueba si se ha cambiado algo
begin
DSPrincipal.DataSet.Post;
// Deberiamos registrar por seguridad, el usuario que ha hecho el cambio, fecha, hora y cantidad anterior y cantidad actual
IBT.CommitRetaining; //Donde IBT es el nombre de su Ibtrasaction, con ruta
actualizar;
end else
begin
ShowMessage('Los registros no se han modificado'); //Este else realmente no es necesario
if DsPrincipal.DataSet.State in [dsEdit,dsInsert] then DSPrincipal.DataSet.Cancel;
end;
except
on E: Exception do
begin
MessageBeep(1000);
ShowMessage('Se ha producido un error y el proceso no se ha podido terminar Unidad:[ URegulaStock ] 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 TFRegulaStock.SBImprimirClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Abrir Imprimir ]******
//------------------------------------------------------------------------------
begin
GBImprimir.Visible:=True;
end;
procedure TFRegulaStock.SBMas1Click(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************[ Avanzar un registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Next;
end;
procedure TFRegulaStock.SBMasXClick(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************[ Avanzar x Registros ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.MoveBy(SEMobeByX.Value);
end;
procedure TFRegulaStock.SBMenos1Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Retroceder 1 registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Prior;
end;
procedure TFRegulaStock.SBMenosxClick(Sender: TObject);
//------------------------------------------------------------------------------
//**********************************************[ Retroceder x Registros ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.MoveBy(-SEMobeByX.Value);
end;
procedure TFRegulaStock.SbModificarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Editar el actual registro ]******
//------------------------------------------------------------------------------
begin
if DsPrincipal.DataSet.IsEmpty<>true then
begin
DSPrincipal.DataSet.Edit;
DBNRSExistencias.SetFocus;
end else ShowMessage('No hay tregistros disponibles para editar')
end;
procedure TFRegulaStock.SbNuevoClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Creamos un nuevo registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Insert;
DBNRSExistencias.SetFocus;
end;
procedure TFRegulaStock.SBPrimeroClick(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Ir al Primer Registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.First;
end;
procedure TFRegulaStock.SBUltimoClick(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Ir al último registro ]******
//------------------------------------------------------------------------------
begin
DSPrincipal.DataSet.Last;
end;
procedure TFRegulaStock.SB_SalirClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Salir Del Form ]******
//------------------------------------------------------------------------------
begin
FRegulaStock.Close;
end;
procedure TFRegulaStock.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