Skip to content

Instantly share code, notes, and snippets.

/gist:6171280

Created August 7, 2013 04:52
Download ZIP
Módulo auxiliar de documentos de programa de Gestión desde 0
Raw
gistfile1.txt
unit UExtPPAF;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, IBDatabase,
NewPanelDB, //Para usar el NEwPanelDB
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
Dialogs, ComCtrls, ExtCtrls, Grids, DBGrids, StdCtrls, Spin, Buttons, DB, DBCtrls,
EditDefault, ImgList, IBCustomDataSet, IBQuery, DBneweditjl, Mneweditjl;
type
TFExtPPAF = class(TForm)
PanelBotonera: TNewPanelDB;
SBBarraStatus: TStatusBar;
Panel1: TPanel;
SB_Salir: TSpeedButton;
SBBuscar: TSpeedButton;
GBBuscar: TGroupBox;
Ebusqueda: TEdit;
BLimpiar: TButton;
BBuscar: TButton;
BCerrar: TButton;
Timer1: TTimer;
stateImages: TImageList;
RadioGroup1: TRadioGroup;
SBSalirPasarDatos: TSpeedButton;
IBQProductos: TIBQuery;
DSPRODUCTOS: TDataSource;
DSIbqProductos: TDataSource;
IbqPeciosClientes: TIBQuery;
IBQStockCaduco: TIBQuery;
DsProductosLotes: TDataSource;
SBBusquedaAvanzada: TSpeedButton;
DSPRINCIPAL: TDataSource;
Paneldatos: TNewPanelDB;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label13: TLabel;
Label12: TLabel;
Label14: TLabel;
SBNuevoArticulo: TSpeedButton;
SpeedButton4: TSpeedButton;
SBLotesExtendido: TSpeedButton;
Panel3: TPanel;
GroupBox1: TGroupBox;
ListView1: TListView;
Panel2: TPanel;
DBText1: TDBText;
DBText2: TDBText;
Label19: TLabel;
Label20: TLabel;
Label21: TLabel;
Label22: TLabel;
Label24: TLabel;
Label25: TLabel;
DBTMediaComision: TDBText;
DBTDtoRapel: TDBText;
Label26: TLabel;
DBTDescuento: TDBText;
Label27: TLabel;
DBTTarifa: TDBText;
Panel4: TPanel;
DBIBCheckbox2: TDBIBCheckbox;
GroupBox2: TGroupBox;
Label28: TLabel;
Label29: TLabel;
Label30: TLabel;
Label31: TLabel;
Label32: TLabel;
Label33: TLabel;
SpeedButton2: TSpeedButton;
StringGrid1: TStringGrid;
Edit1: TEdit;
EditDefFecha: TEditDefault;
Edit2: TEdit;
EditDefFechaCaduco: TEditDefault;
Edit3: TEdit;
DBIBCheckboxServicio: TDBIBCheckbox;
EditDefault1: TEditDefault;
EditDefault2: TEditDefault;
DBNExtCodigoArticulo: TDBNewEditJL;
DBNExtPesoUnidad: TDBNewEditJL;
DBNExtDescripcionArticulo: TDBNewEditJL;
DBNExtMiniNota: TDBNewEditJL;
DBNExtCantidad: TDBNewEditJL;
DBNExtPrecioUnidad: TDBNewEditJL;
DBNExtImpuesto: TDBNewEditJL;
DBNExtDescuento: TDBNewEditJL;
DBNExtComision: TDBNewEditJL;
DBNewEditJL5: TDBNewEditJL;
NEDVencimientos: TMyNewEditJL;
NEDLotes: TMyNewEditJL;
NEDADR: TMyNewEditJL;
procedure FormKeyPress(Sender: TObject; var Key: Char);
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 SB_SalirClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
procedure StringGrid1Exit(Sender: TObject);
procedure SBSalirPasarDatosClick(Sender: TObject);
procedure SBNuevoArticuloClick(Sender: TObject);
procedure Edit3Exit(Sender: TObject);
procedure Edit2Exit(Sender: TObject);
procedure EditDefFechaExit(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SBBusquedaAvanzadaClick(Sender: TObject);
procedure EditDefFechaEnter(Sender: TObject);
procedure LimpiarLoteManual;
procedure limpiarStrinGrid;
procedure SBLotesExtendidoClick(Sender: TObject);
procedure DBNExtCodigoArticuloChange(Sender: TObject);
procedure DBNExtCodigoArticuloExit(Sender: TObject);
procedure DBNExtCantidadChange(Sender: TObject);
procedure DBNExtPrecioUnidadExit(Sender: TObject);
procedure DBNExtDescuentoExit(Sender: TObject);
procedure NEDLotesChange(Sender: TObject);
procedure NEDVencimientosChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FExtPPAF: TFExtPPAF;
IBT:TIBTransaction;
varExtppafTempo:Boolean;
varExtppaf:Integer;
implementation
{$R *.dfm}
USES UDM, Fun,FUN_DBGRID, uxpaf, UMenu, UbusquedaFP, UArticulos, UEntradas, UEntLotExt;
procedure TFExtPPAF.BBuscarClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ Buscar ]******
//------------------------------------------------------------------------------
var Campo:string;
begin
if RadioGroup1.ItemIndex=0 then Campo:='PRODUCTO'
else Campo:='CODIGO';
DSPRODUCTOS.DataSet.Locate(Campo,Ebusqueda.Text,[loCaseInsensitive,loPartialKey]);
end;
procedure TFExtPPAF.BCerrarClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Cerrar Busqueda ]******
//------------------------------------------------------------------------------
begin
BLimpiarClick(Sender);
GBBuscar.Visible:=False;
end;
procedure TFExtPPAF.BLimpiarClick(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************[ Limpia la busqueda ]******
//------------------------------------------------------------------------------
begin
Ebusqueda.Text:='';
BBuscarClick(Sender);
Ebusqueda.SetFocus;
end;
procedure TFExtPPAF.DBNExtDescuentoExit(Sender: TObject);
//------------------------------------------------------------------------------
//**********************************************************[ Salir de DTO ]****
//------------------------------------------------------------------------------
begin
DBNExtPrecioUnidadExit(Sender); //PAra que aplique el dto
end;
procedure TFExtPPAF.DBNExtCantidadChange(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************************[ Change Cantidad ]****
//------------------------------------------------------------------------------
var VarRCalulo,VarRprecio:Real;
begin //HAcemos los Calculos Pertinentes
if FExtPPAF.Active then
begin
if DBNExtCantidad.Text<>'' then
begin
if DBNExtCantidad.Text<>'-' then
begin
varRprecio:=DBNExtPrecioUnidad.Field.Value;
if DBNExtDescuento.Text<>'' then VarRprecio:=DBNExtPrecioUnidad.Field.Value-Porcentaje(DBNExtPrecioUnidad.Field.Value,DBNExtDescuento.Field.Value)
else VarRprecio:=DBNExtPrecioUnidad.Field.Value;
VarRCalulo:=StrToInt(DBNExtCantidad.Text)*VarRprecio;
EditDefault1.Text:=FloatToStr(VarRprecio);
EditDefault2.Text:=FloatToStr(VarRCalulo);
end;
end;
end;
end;
procedure TFExtPPAF.DBNExtCodigoArticuloChange(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ Onchange ]****
// USamos el mismo para todos
//------------------------------------------------------------------------------
begin
if FExtPPAF.Active then
begin
if DBNExtCodigoArticulo.Text<>'' then ActQuery(IBQProductos,'Select * From ARTICULOS where upper(CODIGO)=UPPER('+QuotedStr(DBNExtCodigoArticulo.Text)+')');
end;
end;
procedure TFExtPPAF.DBNExtCodigoArticuloExit(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************************[ Sale Del Código ]****
//------------------------------------------------------------------------------
var i,VarIPos:integer;
VarRPre:Real;
begin
if DBNExtCodigoArticulo.Text<>'' then ActQuery(IBQProductos,'Select * From ARTICULOS where upper(CODIGO)=UPPER('+QuotedStr(DBNExtCodigoArticulo.Text)+')');
if (DBNExtCodigoArticulo.Text='') or (IBQProductos.IsEmpty) then
begin
ShowMessage('No ha introducido un artículo, o el código introducido no es valido');
DBNExtCodigoArticulo.SetFocus;
end
else begin
DBNExtDescripcionArticulo.Field.Value:=IBQProductos.FieldByName('PRODUCTO').Value;
DBNExtPesoUnidad.Field.value:=IBQProductos.FieldByName('PESO').Value;
NEDADR.Text:=IBQProductos.FieldByName('ADR').AsString;
ListView1.Items.Clear; //Cargamos el Report de precios
for I := 0 to 4 do
begin
with ListView1.Items.Add do //Precio normal
begin
case I of
0:SubItems.Add('Precio normal');
1:SubItems.Add('Precio 2');
2:SubItems.Add('Precio 3');
3:SubItems.Add('Precio 4');
4:SubItems.Add('Precio 5');
end;
SubItems.Add(IntToStr(IBQProductos.FieldByName('RAPEL'+IntToStr(I+1)).Value));
SubItems.Add(FloattoStr(IBQProductos.FieldByName('DTO'+IntToStr(I+1)).Value));
SubItems.Add(FloattoStr(IBQProductos.FieldByName('PV'+IntToStr(I+1)).Value));
end;
end;
if DBNExtCodigoArticulo.Text<>'' then //Precios especiales para clientes
begin
ActQuery(IbqPeciosClientes,'SELECT * FROM PRECIOSESPECIALES' +
' WHERE (Upper(CODIGOARTICULO) = Upper('+QuotedStr(DBNExtCodigoArticulo.Text)+')) ' +
' AND (Upper(CODIGOCLIENTE) = Upper('+QuotedStr(FXPAF.DBNCodigoCliente.Text)+ '))');
end;
if not (IbqPeciosClientes.IsEmpty) then
begin
with ListView1.Items.Add do //Precio 5
begin
SubItems.Add('Precio Esp. Cliente');
SubItems.Add('');
SubItems.Add(FloattoStr(IbqPeciosClientes.FieldByName('DESCUENTO').value));
SubItems.Add(FloattoStr(IbqPeciosClientes.FieldByName('PRECIO').value));
end;
end;
//Marcamos el precio
if not (IbqPeciosClientes.IsEmpty) then //Si tiene un precio asignado (especial)
begin
VarIPos:=5;
ListView1.items[5].Checked:=true;
VarRPre:=StrToFloat(ListView1.Items[5].SubItems[3]);
DBNExtPrecioUnidad.Field.Value:=VarRPre;
end else
begin
if (StrToInt(DBTTarifa.Caption)<1) or (StrToInt(DBTTarifa.Caption)>5) or (DBTTarifa.Caption='')then //Por si falla la tarifa
begin
VarIPos:=0;
ListView1.items[0].Checked:=true;
VarRPre:=StrToFloat(ListView1.Items[0].SubItems[3]);
DBNExtPrecioUnidad.Field.Value:=VarRPre;
end else
begin //Tarifa asignada
I:=StrToInt(DBTTarifa.Caption)-1;
if StrToFloat(ListView1.Items[I].SubItems[3])<=0 then I:=0;
VarIPos:=I;
ListView1.items[I].Checked:=true;
VarRPre:=StrToFloat(ListView1.Items[I].SubItems[3]);
DBNExtPrecioUnidad.Field.Value:=VarRPre;
end;
end;
DBNExtDescuento.Field.Value:=0;
if (StrToFloat(ListView1.Items[VarIPos].SubItems[2])<=0) or (ListView1.Items[VarIPos].SubItems[2]='') then //Los Descuentos
begin
try
if DBTDescuento.Caption<>'' then DBNExtDescuento.Field.Value:=StrToFloat(DBTDescuento.Caption)
else DBNExtDescuento.Field.Value:=0;
except
DBNExtDescuento.Field.Value:=0;
end;
end else
begin
try
if DBTDescuento.Caption<>'' then
begin
if StrToFloat(ListView1.Items[VarIPos].SubItems[2])>=StrToFloat(DBTDescuento.Caption) then DBNExtDescuento.Field.Value:=StrToFloat(DBTDescuento.Caption)
Else DBNExtDescuento.Field.Value:=StrToFloat(ListView1.Items[VarIPos].SubItems[2])
end;
except
DBNExtDescuento.Field.Value:=StrToFloat(ListView1.Items[VarIPos].SubItems[2]);
end
end;
if DBTMediaComision.Caption<>'' then //La Comision
begin
try
if StrToFloat(DBTMediaComision.Caption)>0 then
begin
if DBTDtoRapel.Caption<>'' then
begin
if StrToFloat(DBTDtoRapel.Caption)>0 then
begin
if FXPAF.IBQClientes.FieldByName('USARRAPEL').Value='S' then DBNExtComision.Field.Value:=StrToFloat(DBTMediaComision.Caption)-Porcentaje(StrToFloat(DBTMediaComision.Caption),StrToFloat(DBTDtoRapel.Caption))
else DBNExtComision.Field.Value:=StrToFloat(DBTMediaComision.Caption);
end else DBNExtComision.Field.Value:=StrToFloat(DBTMediaComision.Caption);
end else DBNExtComision.Field.Value:=StrToFloat(DBTMediaComision.Caption);
end else DBNExtComision.Field.Value:=0;
except
DBNExtComision.Field.Value:=0;
end;
end else DBNExtComision.Field.Value:=0;
if DBNExtCodigoArticulo.Text<>'' then //Mostramos El Stock disponible y Su caducidad
begin
limpiarStrinGrid;
ActQuery(IBQStockCaduco,'SELECT * FROM STOCK '+ //Buscamos los articulos de este código que tengan existencias
' WHERE (UPPER(CODIGOPRODUCTO) = UPPER('+QuotedStr(DBNExtCodigoArticulo.Text)+')) AND '+
'(EXISTENCIAS >= 1) ORDER BY CADUCIDAD');
IBQStockCaduco.First;
I:=1;
while not IBQStockCaduco.Eof do
begin
if IBQStockCaduco.FieldByName('EXISTENCIAS').Value>=1 then I:=I+1;
IBQStockCaduco.Next;
end;
IBQStockCaduco.First;
StringGrid1.RowCount:=I;
I:=1;
while not IBQStockCaduco.Eof do
begin
if IBQStockCaduco.FieldByName('EXISTENCIAS').Value>=1 then
begin
StringGrid1.Cells[0,I]:=IBQStockCaduco.FieldByName('LOTE').AsString;
StringGrid1.Cells[1,I]:=IBQStockCaduco.FieldByName('FECHAENTRADA').AsString;
StringGrid1.Cells[2,I]:=IBQStockCaduco.FieldByName('CANTIDADDEENTRADA').AsString;
StringGrid1.Cells[3,I]:=IBQStockCaduco.FieldByName('EXISTENCIAS').AsString;
StringGrid1.Cells[4,I]:=IBQStockCaduco.FieldByName('CADUCIDAD').AsString;
end;
I:=I+1;
IBQStockCaduco.Next;
end;
end;
if StringGrid1.RowCount>1 then
begin
StringGrid1.Row:=1;
StringGrid1.Col:=5;
StringGrid1.SetFocus;
end else Edit1.SetFocus;
end;
end;
procedure TFExtPPAF.EbusquedaChange(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************[ Mientras se escribe en busqueda ]******
//------------------------------------------------------------------------------
begin
BBuscarClick(sender);
end;
procedure TFExtPPAF.Edit2Exit(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************[ Salir de Cantidad lotes ]*******
//------------------------------------------------------------------------------
begin
if Edit2.Text<>'' then
begin
try
StrToInt(Edit2.Text);
Label32.Caption:='[ '+Edit2.Text+' ]';
except
ShowMessage('El dato introducido no es una cantidad entera');
Edit2.SetFocus;
end;
end;
end;
procedure TFExtPPAF.Edit3Exit(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************[ Nuevo lotes introducidos ]*******
//------------------------------------------------------------------------------
var VarIControlError, VarICantIntr:Integer;
VarbEncontrado:Boolean;
begin
VarIControlError:=0;
VarbEncontrado:=False;
if Edit3.Text='' then
begin
if Edit2.Text<>'' then
begin
Edit3.Text:=Edit2.Text;
Edit3.SetFocus;
end;
end else
if Edit3.Text<>'' then
begin
Case MessageBox(0,pchar( '¿Desea que el núevo lote sea registrado, como entrada de la empresa?' +#13#10),pchar('Nuevo lote detectado'),4+32+0+4096) of
6:begin //Si
try
VarIControlError:=1;
VarICantIntr:=StrToInt(Edit2.Text);
// STOCK
VarbEncontrado:=DsProductosLotes.DataSet.Locate('CODIGOPRODUCTO;LOTE', VarArrayOf([DBNExtCodigoArticulo.Text, Edit1.Text]), [LoCaseInsensitive, LoPartialKey]);
if not VarbEncontrado then DsProductosLotes.DataSet.Insert
else DsProductosLotes.DataSet.Edit;
DsProductosLotes.DataSet.FieldByName('CODIGOPRODUCTO').Value:=DBNExtCodigoArticulo.Field.Value;
if Edit2.Text<>'' then
begin
DsProductosLotes.DataSet.FieldByName('CANTIDADDEENTRADA').Value:=VarICantIntr;
if VarbEncontrado then DsProductosLotes.DataSet.FieldByName('EXISTENCIAS').Value:=DsProductosLotes.DataSet.FieldByName('EXISTENCIAS').Value+StrToInt(Edit2.Text)
else DsProductosLotes.DataSet.FieldByName('EXISTENCIAS').Value:=VarICantIntr;
end else
begin
DsProductosLotes.DataSet.FieldByName('CANTIDADDEENTRADA').Value:=0;
DsProductosLotes.DataSet.FieldByName('EXISTENCIAS').Value:=0;
end;
if Edit1.Text<>'' then DsProductosLotes.DataSet.FieldByName('LOTE').Value :=Edit1.Text
else DsProductosLotes.DataSet.FieldByName('LOTE').Value := 'Lote no facilitado';
DsProductosLotes.DataSet.FieldByName('FECHAENTRADA').Value:=StrToDate(EditDefFecha.Text);
DsProductosLotes.DataSet.Post;
except
ShowMessage('Se Ha producido un error');
if DsProductosLotes.DataSet.State in [dsEdit,dsInsert] then DsProductosLotes.DataSet.Cancel;
if DSPRODUCTOS.DataSet.State in [dsEdit,dsInsert] then DSPRODUCTOS.DataSet.Cancel;
end;
End;
end;
StringGrid1Exit(Sender); //Cargamos los datos
end;
end;
procedure TFExtPPAF.EditDefFechaEnter(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************[ entrar en la fecha ]****
//------------------------------------------------------------------------------
begin
EditDefFecha.Text:=DateToStr(Now);
end;
procedure TFExtPPAF.EditDefFechaExit(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Salir de Fecha ]*******
//------------------------------------------------------------------------------
begin
if EditDefFecha.Text<>'' then
begin
try
StrToDate(EditDefFecha.Text);
EditDefFechaCaduco.Text:=DateToStr(EditDefFecha.MyDate+365);
except
ShowMessage('La fecha introducida no es valida');
EditDefFecha.SetFocus;
end;
end;
end;
procedure TFExtPPAF.FormActivate(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************[ Cuando se activa El form ]******
// Lo que queremos que haga nuestro Form Cuando se Actiba
//------------------------------------------------------------------------------
begin
if DSPRINCIPAL.DataSet.State in [dsInsert] then DBNExtImpuesto.Field.Value:=DM.IBDCONFIIMPUESTO1.AsString; //Cargamos el Valor por defecto
if Timer1.Enabled=false then Timer1.Enabled:=True;
Label20.Caption:=FXPAF.Label44.Caption;
Caption:='Auxiliar de [ '+VarSTipoDocumento+' ]';
Label19.Caption:='Serie-número ['+VarSTipoDocumento+']:';
QuerryOC(IBQProductos,true);
DBNExtCodigoArticulo.SetFocus;
end;
procedure TFExtPPAF.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(IBQProductos);
QuerryOC(IbqPeciosClientes);
QuerryOC(IBQStockCaduco);
end;
procedure TFExtPPAF.FormCreate(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************[ Al Crearse el Fom ]******
// Cosas que queremos que haga según se inicie el Form
//------------------------------------------------------------------------------
begin
StringGrid1.Cells[0,0]:='Lote';
StringGrid1.Cells[1,0]:='Fecha';
StringGrid1.Cells[2,0]:='Cantidad de entrada';
StringGrid1.Cells[3,0]:='Disponible';
StringGrid1.Cells[4,0]:='Caducidad';
StringGrid1.Cells[5,0]:='A usar';
varExtppafTempo:=False;
varExtppaf:=0;
end;
procedure TFExtPPAF.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)
or (ActiveControl is TStringGrid) then
begin
Key := #0; { anula la puulsación }
Perform(WM_NEXTDLGCTL, 0, 0); { mueve al próximo control }
end
end;
procedure TFExtPPAF.LimpiarLoteManual;
//------------------------------------------------------------------------------
//*****************************************************[ LimpiarLoteManual ]****
//------------------------------------------------------------------------------
begin
Edit1.Text:='';
Edit2.Text:='';
Edit3.Text:='';
end;
procedure TFExtPPAF.limpiarStrinGrid;
//------------------------------------------------------------------------------
//******************************************************[ limpiarStrinGrid ]****
//------------------------------------------------------------------------------
var I:Integer;
begin
for I := 1 to StringGrid1.RowCount - 1 do StringGrid1.Rows[i].Clear;
StringGrid1.Cells[0,0]:='Lote';
StringGrid1.Cells[1,0]:='Fecha';
StringGrid1.Cells[2,0]:='Cantidad de entrada';
StringGrid1.Cells[3,0]:='Disponible';
StringGrid1.Cells[4,0]:='Caducidad';
StringGrid1.Cells[5,0]:='A usar';
end;
procedure TFExtPPAF.ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
var DefaultDraw: Boolean);
//------------------------------------------------------------------------------
//********************************************************[ CustomDrawItem ]****
// bajado de http://delphi.about.com/od/delphitips2008/qt/lv_checkbox_bmp.htm
//------------------------------------------------------------------------------
var
r : TRect;
begin
r := item.DisplayRect(drIcon);
if stage = cdPostPaint then
if item.Checked then stateImages.Draw(Sender.Canvas, r.Left - 18, r.Top, 1)
else stateImages.Draw(Sender.Canvas, r.Left - 18, r.Top, 2);
end;
procedure TFExtPPAF.NEDLotesChange(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Cambia los lotes ]****
//------------------------------------------------------------------------------
begin
FXPAF.NEDResumenLotes.Text:=NEDLotes.Text;
end;
procedure TFExtPPAF.NEDVencimientosChange(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Cambia los Vencimientos ]****
//------------------------------------------------------------------------------
begin
FXPAF.NEDResumenVencimientos.Text:=NEDVencimientos.Text;
end;
procedure TFExtPPAF.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');
end;
end;
procedure TFExtPPAF.SBBuscarClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Abrir Busqueda ]******
//------------------------------------------------------------------------------
begin
GBBuscar.Visible:=True;
Ebusqueda.SetFocus;
end;
procedure TFExtPPAF.SB_SalirClick(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Salir Del Form ]******
//------------------------------------------------------------------------------
begin
LimpiarLoteManual;
limpiarStrinGrid;
FExtPPAF.Close;
end;
procedure TFExtPPAF.SBNuevoArticuloClick(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Llamamos a articulos ]*******
//------------------------------------------------------------------------------
begin
try
FArticulos.FormStyle:=fsStayOnTop;
FMenu.ACT_ArticulosExecute(Sender);
finally
DBNExtCodigoArticulo.SetFocus;
end;
end;
procedure TFExtPPAF.SBSalirPasarDatosClick(Sender: TObject);
//------------------------------------------------------------------------------
//*************************************************[ Salir y actualizar ]*******
//------------------------------------------------------------------------------
begin
LimpiarLoteManual;
limpiarStrinGrid;
FXPAF.SetFocus;
FExtPPAF.Close;
if (DBNExtCantidad.Text<>'0') and (DBNExtCantidad.Text<>'') then
begin
FXPAF.NEDResumenLotes.Text:=NEDLotes.Text;
FXPAF.NEDResumenVencimientos.Text:=NEDVencimientos.Text;
FXPAF.autograb(Sender);
end;
end;
procedure TFExtPPAF.SpeedButton2Click(Sender: TObject);
//------------------------------------------------------------------------------
//***********************************************[ Entrada de productos ]*******
//------------------------------------------------------------------------------
begin
FEntradas.FormStyle:=fsStayOnTop;
FEntradas.ShowModal;
end;
procedure TFExtPPAF.SBBusquedaAvanzadaClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************************[ Buscar Articulo ]****
//------------------------------------------------------------------------------
begin
VarSTabla:='ARTICULOS'; //Pertenece al formularios UFbusquedaFP
VarSNomMod:='EXTXPAF'; //Desde que modulo lo llamamos
FbusquedaFP.Show;
end;
procedure TFExtPPAF.SBLotesExtendidoClick(Sender: TObject);
//------------------------------------------------------------------------------
//*******************************************************[ Lotes Extendido ]****
//------------------------------------------------------------------------------
begin
if NEDLotes.Text<>'' then
begin
FEntLoteExt.EdLote.Text:='';
FEntLoteExt.EdFecha.Text:=DateToStr(Now);
FEntLoteExt.EdCantidad.Text:='';
FEntLoteExt.EdFechaCaducidad.Text:=DateToStr(Now);
FEntLoteExt.EdUsar.Text:='';
FEntLoteExt.EDCodigoArticulo.Text:=DBNExtCodigoArticulo.Text;
FEntLoteExt.ShowModal;
end else ShowMessage('No hay lotes previos, use el lote en color naranja');
end;
procedure TFExtPPAF.StringGrid1Exit(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************[ Salir del Stringrid ]****
//------------------------------------------------------------------------------
var I,VarICantidad,VarISuma,VarIUsar:Integer;
VarSCaduco,VarsLotes:string;
begin
VarSCaduco:='';
VarsLotes:='';
VarISuma:=0;
for I := 1 to StringGrid1.RowCount - 1 do
begin
if StringGrid1.Cells[3,I]<>'' then VarICantidad:=StrToInt(StringGrid1.Cells[3,I])
else VarICantidad:=0;
if StringGrid1.Cells[5,I]<>'' then VarIUsar:=StrToInt(StringGrid1.Cells[5,I])
else VarIUsar:=0;
if VarIUsar>VarICantidad then
begin
ShowMessage('La cantidad introducida es superior al disponible'+chr(13)+
'La cantidad máxima del articulo con lote [ '+StringGrid1.Cells[0,I]+
' ] es de [ '+IntToStr(VarICantidad)+' ]. Se regulara a esta cantidad');
VarIUsar:=VarICantidad;
StringGrid1.Cells[5,I]:=StringGrid1.Cells[3,I];
end;
if VarIUsar<>0 then
begin
VarISuma:=VarISuma+VarIUsar;
if StringGrid1.Cells[4,I]<>'' then VarSCaduco:=VarSCaduco+'['+IntToStr(VarIUsar)+'] ('+StringGrid1.Cells[4,I]+') - ';
if StringGrid1.Cells[0,I]<>'' then VarsLotes:=VarsLotes+'['+IntToStr(VarIUsar)+'] ('+StringGrid1.Cells[0,I]+') - ';
end;
end;
if (Edit3.Text<>'') and (Edit1.Text<>'') then
begin
VarISuma:=VarISuma+StrToInt(Edit3.Text);
if EditDefFechaCaduco.Text<>'' then VarSCaduco:=VarSCaduco+'['+Edit3.Text+'] ('+EditDefFechaCaduco.Text+') - ';
if Edit1.Text<>'' then VarsLotes:=VarsLotes+'['+Edit3.Text+'] ('+Edit1.Text+') - ';
end;
if VarISuma<>0 then DBNExtCantidad.Field.Value:=VarISuma;
if VarsLotes<>'' then NEDLotes.Text:=Copy(VarsLotes,0,(Length(VarsLotes)-3));
if VarSCaduco<>'' then NEDVencimientos.Text:=Copy(VarSCaduco,0,(Length(VarSCaduco)-3));
DBNExtComision.SetFocus;
DBNExtCantidadChange(Sender);
end;
procedure TFExtPPAF.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);
if (varExtppafTempo) and ( FExtPPAF.Active) then
begin
if varExtppaf=5 then
begin
DBNExtPrecioUnidadExit(Sender);
varExtppaf:=0;
end;
varExtppafTempo:=False;
end;
end;
procedure TFExtPPAF.DBNExtPrecioUnidadExit(Sender: TObject);
//------------------------------------------------------------------------------
//******************************************************[ Salir del precio ]****
//------------------------------------------------------------------------------
begin
DBNExtPrecioUnidad.Field.Value:=StrToFloat(DBNExtPrecioUnidad.Text);
DBNExtCantidadChange(Sender);
end;
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment