Skip to content

Instantly share code, notes, and snippets.

Created August 10, 2013 12:06
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/6200188 to your computer and use it in GitHub Desktop.
Save anonymous/6200188 to your computer and use it in GitHub Desktop.
Creador de rutas de programa de Gestión desde 0
unit URutas;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, DBCtrls, Buttons, ExtCtrls, DB, IBCustomDataSet,
IBQuery, rpcompobase, rpvclreport;
type
TFRutas = class(TForm)
Panel1: TPanel;
SB_Salir: TSpeedButton;
Label2: TLabel;
Label3: TLabel;
SpeedButton1: TSpeedButton;
DateTimePicker1: TDateTimePicker;
DateTimePicker2: TDateTimePicker;
Panel2: TPanel;
Panel5: TPanel;
ListView1: TListView;
Panel8: TPanel;
SpeedButton7: TSpeedButton;
SpeedButton8: TSpeedButton;
Panel3: TPanel;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
SpeedButton12: TSpeedButton;
Label5: TLabel;
Label8: TLabel;
Panel4: TPanel;
Panel6: TPanel;
ListView2: TListView;
Panel7: TPanel;
SpeedButton6: TSpeedButton;
SpeedButton9: TSpeedButton;
SpeedButton10: TSpeedButton;
SpeedButton11: TSpeedButton;
SpeedButton13: TSpeedButton;
SpeedButton14: TSpeedButton;
SpeedButton15: TSpeedButton;
IBQbuscli: TIBQuery;
IbqbusDoc: TIBQuery;
Label1: TLabel;
DateTimePicker3: TDateTimePicker;
DsDocumentos: TDataSource;
DsBusCli: TDataSource;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
VCLReport1: TVCLReport;
SpeedButton16: TSpeedButton;
IbqbusDocID: TIntegerField;
IbqbusDocTIPODOCUMENTO: TIBStringField;
IbqbusDocNUMERODOCUMENTO: TIBStringField;
IbqbusDocSERIE: TIBStringField;
IbqbusDocCODIGOCLIENTE: TIBStringField;
IbqbusDocDESCRIPCIONCLIENTE: TIBStringField;
IbqbusDocIDDIRECCIONES: TIntegerField;
IbqbusDocCODIGOAGENTE: TIBStringField;
IbqbusDocDESCRIPCIONAGENTE: TIBStringField;
IbqbusDocFECHA: TDateField;
IbqbusDocNUMERODECOBRO: TIBStringField;
IbqbusDocCOBRADO: TIBStringField;
IbqbusDocNUMERORUTA: TIBStringField;
IbqbusDocFECHAENTREGA: TDateField;
IbqbusDocFORMADEPAGO: TIBStringField;
IbqbusDocDESCRIPCIONFORMADEPAGO: TIBStringField;
IbqbusDocNUMEROFINANCIADO: TIBStringField;
IbqbusDocTOTALFINANCIADO: TIBBCDField;
IbqbusDocNUMERORETENCIONES: TIBStringField;
IbqbusDocTOTALRETENCIONES: TIBBCDField;
IbqbusDocPORCENTAJERETENCIONES: TIBBCDField;
IbqbusDocTOTALCOMISIONES: TIBBCDField;
IbqbusDocNUMEROPROTECCIONDATOS: TIntegerField;
IbqbusDocCAMPOLIBRE: TIBStringField;
IbqbusDocMODIFICACIONES: TIntegerField;
IbqbusDocESTADO: TIBStringField;
IbqbusDocNUMERORELACIONFACTURAS: TIBStringField;
IbqbusDocSERIERELACIONFACTURAS: TIBStringField;
IbqbusDocSUBTOTAL: TIBBCDField;
IbqbusDocTOTALDESCUENTOS: TIBBCDField;
IbqbusDocTOTALPESO: TIBBCDField;
IbqbusDocTOTALIMPUESTOS: TIBBCDField;
IbqbusDocTOTALIMPUESTO1: TIBBCDField;
IbqbusDocTOTALIMPUESTO2: TIBBCDField;
IbqbusDocTOTALIMPUESTO3: TIBBCDField;
IbqbusDocTOTALIMPUESTO4: TIBBCDField;
IbqbusDocMININOTA: TIBStringField;
IbqbusDocPORCENTAJEFINANCIADO: TIBBCDField;
DsRutas: TDataSource;
IBQbuscliID: TIntegerField;
IBQbuscliNOMMODULO: TIBStringField;
IBQbuscliCODIGO: TIBStringField;
IBQbuscliNOMBRE: TIBStringField;
IBQbuscliFORMAPAGO: TIBStringField;
IBQbuscliFECHAALTA: TDateField;
IBQbuscliDTO: TIBBCDField;
IBQbuscliNOTAS: TWideMemoField;
IBQbuscliIMG: TBlobField;
IBQbuscliIMPUESTOS: TIBStringField;
IBQbuscliTIPOIMP: TIntegerField;
IBQbuscliCIF: TIBStringField;
IBQbuscliRET: TIBStringField;
IBQbuscliPORRET: TIBBCDField;
IBQbuscliTARIFA: TIBStringField;
IBQbuscliUSARRAPEL: TIBStringField;
IBQbuscliDIASPRESENT: TIBStringField;
IBQbuscliDIASDECOBRO: TIBStringField;
IBQbuscliAVISOS: TWideMemoField;
IBQbuscliLIMITECREDITO: TIBBCDField;
IBQbuscliPENDIENTEPAGO: TIBBCDField;
IBQbuscliSECTOR: TIBStringField;
IBQbuscliCODAGENTE: TIBStringField;
Label4: TLabel;
Label6: TLabel;
DBText1: TDBText;
DBText2: TDBText;
DSEmpleados: TDataSource;
DSVehiculos: TDataSource;
CBEmpleados: TComboBox;
CBVehiculos: TComboBox;
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
procedure SpeedButton12Click(Sender: TObject);
procedure SpeedButton7Click(Sender: TObject);
procedure SpeedButton8Click(Sender: TObject);
procedure SpeedButton10Click(Sender: TObject);
procedure SpeedButton9Click(Sender: TObject);
procedure SpeedButton11Click(Sender: TObject);
procedure SpeedButton14Click(Sender: TObject);
procedure SpeedButton15Click(Sender: TObject);
procedure SB_SalirClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure ListView1CustomDrawItem(Sender: TCustomListView; Item: TListItem;
State: TCustomDrawState; var DefaultDraw: Boolean);
procedure ListView2CustomDrawItem(Sender: TCustomListView; Item: TListItem;
State: TCustomDrawState; var DefaultDraw: Boolean);
procedure SpeedButton6Click(Sender: TObject);
procedure SpeedButton13Click(Sender: TObject);
procedure SpeedButton16Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CBEmpleadosDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure CBEmpleadosChange(Sender: TObject);
procedure CBVehiculosChange(Sender: TObject);
procedure CBVehiculosDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FRutas: TFRutas;
implementation
{$R *.dfm}
uses Fun, FUN_DBGRID, UDM, umenu ;
procedure TFRutas.CBEmpleadosChange(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ CBEmpleadosChange ]****
//------------------------------------------------------------------------------
begin
if FRutas.Active then DSEmpleados.DataSet.Locate('CODIGO',EliminaRestoCadena(CBEmpleados.Text,';'),[loCaseInsensitive,loPartialKey]);
DBText1.Visible:=True;
end;
procedure TFRutas.CBEmpleadosDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
//------------------------------------------------------------------------------
//*************************************************[ DBCBEmpleadosDrawItem ]****
// Para mostrar más de una columna en el combobox
//------------------------------------------------------------------------------
var //Bajado de http://www.planetadelphi.com.br/dica/3971/mostra-varias-colunas-em-um-combobox
strVal, strAll: string;
pos1, pos2: Integer;
rc: TRect;
arrWidth: array [0..2] of Integer;
begin
CBEmpleados.Canvas.Brush.Style := bsSolid;
CBEmpleados.Canvas.FillRect(Rect);
// A coluna deve ser separada por ';'
strAll := CBEmpleados.Items[Index];
arrWidth[0] := 0;
arrWidth[1] := 50; // Largura da coluna 1
arrWidth[2] := 350; // Largura da coluna 2
// Desenhando a primeira coluna
rc.Left := Rect.Left + arrWidth[0] + 2;
rc.Right := Rect.Left + arrWidth[1] - 2;
rc.Top := Rect.Top;
rc.Bottom := Rect.Bottom;
// Obtendo texto da primeira coluna
pos1 := Pos(';', strAll);
strVal := Copy(strAll, 1, pos1 - 1);
// Desenhando Texto
CBEmpleados.Canvas.TextRect(rc, rc.Left, rc.Top, strVal);
// Desenhando separador entre colunas
CBEmpleados.Canvas.MoveTo(rc.Right, rc.Top);
CBEmpleados.Canvas.LineTo(rc.Right, rc.Bottom);
// Desenhando segunda coluna
rc.Left := Rect.Left + arrWidth[1] + 2;
rc.Right := Rect.Left + arrWidth[2] - 2;
// Obtendo texto da segunda coluna
strAll := Copy(strAll, pos1 + 1, Length(strAll) - pos1);
pos1 := Pos(';', strAll);
strVal := Copy(strAll, 1, pos1 - 1);
// Desenhando texto
CBEmpleados.Canvas.TextRect(rc, rc.Left, rc.Top, strVal);
// Desenhando separador de colunas
CBEmpleados.Canvas.MoveTo(rc.Right, rc.Top);
CBEmpleados.Canvas.LineTo(rc.Right, rc.Bottom);
// Desenhando texto
CBEmpleados.Canvas.TextRect(rc, rc.Left, rc.Top, strVal);
// Desenhando separador entre colunas
CBEmpleados.Canvas.MoveTo(rc.Right, rc.Top);
CBEmpleados.Canvas.LineTo(rc.Right, rc.Bottom);
strAll := Copy(strAll, pos1 + 1, Length(strAll) - pos1);
end;
procedure TFRutas.CBVehiculosChange(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ CBVehiculosChange ]****
//------------------------------------------------------------------------------
begin
if FRutas.Active then DSVehiculos.DataSet.Locate('MATRICULA',EliminaRestoCadena(CBVehiculos.Text,';'),[loCaseInsensitive,loPartialKey]);
DBText2.Visible:=True;
end;
procedure TFRutas.CBVehiculosDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
//------------------------------------------------------------------------------
//***************************************************[ CBVehiculosDrawItem ]****
// Para mostrar más de una columna en el combobox
//------------------------------------------------------------------------------
var //Bajado de http://www.planetadelphi.com.br/dica/3971/mostra-varias-colunas-em-um-combobox
strVal, strAll: string;
pos1, pos2: Integer;
rc: TRect;
arrWidth: array [0..2] of Integer;
begin
CBVehiculos.Canvas.Brush.Style := bsSolid;
CBVehiculos.Canvas.FillRect(Rect);
// A coluna deve ser separada por ';'
strAll := CBVehiculos.Items[Index];
arrWidth[0] := 0;
arrWidth[1] := 80; // Largura da coluna 1
arrWidth[2] := 350; // Largura da coluna 2
// Desenhando a primeira coluna
rc.Left := Rect.Left + arrWidth[0] + 2;
rc.Right := Rect.Left + arrWidth[1] - 2;
rc.Top := Rect.Top;
rc.Bottom := Rect.Bottom;
// Obtendo texto da primeira coluna
pos1 := Pos(';', strAll);
strVal := Copy(strAll, 1, pos1 - 1);
// Desenhando Texto
CBVehiculos.Canvas.TextRect(rc, rc.Left, rc.Top, strVal);
// Desenhando separador entre colunas
CBVehiculos.Canvas.MoveTo(rc.Right, rc.Top);
CBVehiculos.Canvas.LineTo(rc.Right, rc.Bottom);
// Desenhando segunda coluna
rc.Left := Rect.Left + arrWidth[1] + 2;
rc.Right := Rect.Left + arrWidth[2] - 2;
// Obtendo texto da segunda coluna
strAll := Copy(strAll, pos1 + 1, Length(strAll) - pos1);
pos1 := Pos(';', strAll);
strVal := Copy(strAll, 1, pos1 - 1);
// Desenhando texto
CBVehiculos.Canvas.TextRect(rc, rc.Left, rc.Top, strVal);
// Desenhando separador de colunas
CBVehiculos.Canvas.MoveTo(rc.Right, rc.Top);
CBVehiculos.Canvas.LineTo(rc.Right, rc.Bottom);
// Desenhando texto
CBVehiculos.Canvas.TextRect(rc, rc.Left, rc.Top, strVal);
// Desenhando separador entre colunas
CBVehiculos.Canvas.MoveTo(rc.Right, rc.Top);
CBVehiculos.Canvas.LineTo(rc.Right, rc.Bottom);
strAll := Copy(strAll, pos1 + 1, Length(strAll) - pos1);
end;
procedure TFRutas.FormActivate(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ ONACTIVE ]****
//------------------------------------------------------------------------------
var VarSCodigo,VarSnombre, VarScadena:string;
begin
QuerryOC(IbqbusDoc,true);
QuerryOC(IBQbuscli,True);
DateTimePicker1.Date:=Now;
DateTimePicker2.date:=now;
DateTimePicker3.date:=now;
if CBEmpleados.Items.Count<1 then //Datos de empleados
begin
CBEmpleados.Items.Clear;
DSEmpleados.DataSet.First;
While Not DSEmpleados.DataSet.Eof Do // Realizar mientras no sea fin de archivo
Begin
VarSCodigo:=DSEmpleados.DataSet.FieldByName('CODIGO').AsString;
VarSnombre:=DSEmpleados.DataSet.FieldByName('NOMBRE').AsString;
VarScadena:=VarSCodigo+';'+VarSnombre+';';
CBEmpleados.Items.Add(VarScadena); // Agrego los datos al ComboBox
DSEmpleados.DataSet.Next; // Avanzo un registro en la Tabla
End;
End;
if CBVehiculos.Items.Count<1 then //Datos de empleados
begin
CBVehiculos.Items.Clear;
DSVehiculos.DataSet.First;
While Not DSVehiculos.DataSet.Eof Do // Realizar mientras no sea fin de archivo
Begin
VarSCodigo:=DSVehiculos.DataSet.FieldByName('MATRICULA').AsString;
VarSnombre:=DSVehiculos.DataSet.FieldByName('EMPRESA').AsString;
VarScadena:=VarSCodigo+';'+VarSnombre+';';
CBVehiculos.Items.Add(VarScadena); // Agrego los datos al ComboBox
DSVehiculos.DataSet.Next; // Avanzo un registro en la Tabla
End;
End;
end;
procedure TFRutas.FormClose(Sender: TObject; var Action: TCloseAction);
//------------------------------------------------------------------------------
//***************************************************************[ ONCLOSE ]****
//------------------------------------------------------------------------------
begin
QuerryOC(IbqbusDoc);
QuerryOC(IBQbuscli);
DBText1.Visible:=False;
DBText2.Visible:=False;
end;
procedure TFRutas.FormCreate(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ ONCREATE ]****
//------------------------------------------------------------------------------
begin
CBEmpleados.Style := csOwnerDrawFixed;
SendMessage(CBEmpleados.Handle, CB_SETDROPPEDWIDTH, 350, 0);
CBVehiculos.Style := csOwnerDrawFixed;
SendMessage(CBVehiculos.Handle, CB_SETDROPPEDWIDTH, 350, 0);
end;
procedure TFRutas.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 TFRutas.ListView1CustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
//------------------------------------------------------------------------------
//**************************************************[ Dibujamos el Zebrado ]****
//------------------------------------------------------------------------------
begin
ListviewZebra(ListView1,COLOR1GRID,COLOR2GRID,item);
end;
procedure TFRutas.ListView2CustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
//------------------------------------------------------------------------------
//**************************************************[ Dibujamos el Zebrado ]****
//------------------------------------------------------------------------------
begin
ListviewZebra(ListView2,COLOR1GRID,COLOR2GRID,item);
end;
procedure TFRutas.SB_SalirClick(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************************[ SAlir ]****
//------------------------------------------------------------------------------
begin
FRutas.Close;
end;
procedure TFRutas.SpeedButton10Click(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************************[ Subir 1 ]****
// Sube 1 elemento en el listview
//------------------------------------------------------------------------------
begin
if ListView2.Selected.Index>0 then PosiListView(ListView2,ListView2.Selected.Index-1); //Este sube al elemento anterior
end;
procedure TFRutas.SpeedButton11Click(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************************[ Borrar ]****
//------------------------------------------------------------------------------
begin
ListView2.Clear;
end;
procedure TFRutas.SpeedButton12Click(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************************[ Recargar datos ]****
//------------------------------------------------------------------------------
begin
ListView1.Clear;
ListView2.Clear;
SpeedButton1Click(Sender);
end;
procedure TFRutas.SpeedButton13Click(Sender: TObject);
//------------------------------------------------------------------------------
//**************************************************************[ Sin ruta ]****
//------------------------------------------------------------------------------
var VariCont3ForNotas:Integer;
Item, LI: TListItem;
begin
Try
if ListView2.Items.Count>0 then //Si el listview es mayor que 0
begin
for VariCont3ForNotas := 0 to ListView2.Items.Count -1 do //Contador del listview
begin
Item := ListView2.Items.Item[VariCont3ForNotas];
if DsDocumentos.DataSet.Locate('TIPODOCUMENTO;NUMERODOCUMENTO;SERIE',VarArrayOf([Item.SubItems[0],Item.SubItems[2],Item.SubItems[1]]),[loCaseInsensitive,loPartialKey]) then
begin
DsDocumentos.DataSet.Edit;
DsDocumentos.DataSet.FieldByName('FECHAENTREGA').Value:=DateTimePicker3.Date;
DsDocumentos.DataSet.FieldByName('NUMERORUTA').Value:=StrToInt('-1');
if DsDocumentos.DataSet.State in [dsEdit,dsInsert] then DsDocumentos.DataSet.Post;
end;
end;
DM.IBTransaction1.CommitRetaining;
ShowMessage('Los Doc. seleccionados, han sido marcados como sin ruta');
ListView1.Clear;
ListView2.Clear;
end;
except
on E: Exception do
begin
MessageBeep(1000);
ShowMessage(
'Se ha producido un error y el proceso no se ha podido terminar Unidad:[ uRutas ] Modulo:[ Sin Ruta ]'
+ 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');
DM.IBTransaction1.RollbackRetaining;
end;
end;
end;
procedure TFRutas.SpeedButton14Click(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Sube el Campo 1 ]******
// Sube el Campo a la posición anterior
//------------------------------------------------------------------------------
begin
if (ListView2.Items.Count>0) and ( ListView2.Selected.Index>0) then ExchangeItems(ListView2,ListView2.Selected.Index,ListView2.Selected.Index-1);
end;
procedure TFRutas.SpeedButton15Click(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Baja el Campo 1 ]******
// Baja el Campo a la posición siguiente
//------------------------------------------------------------------------------
begin
if (ListView2.Items.Count>0) and ( ListView2.Selected.Index<ListView2.Items.Count-1 ) then ExchangeItems(ListView2,ListView2.Selected.Index,ListView2.Selected.Index+1);
end;
procedure TFRutas.SpeedButton16Click(Sender: TObject);
var varSElemento:string;
Item, LI: TListItem;
begin
varSElemento:=InputBox('Nuevo elemento de la ruta','Elemento (no más de 20 caracteres)','');
if varSElemento<>'' then
begin
LI:=ListView2.Items.Add;
LI.Caption:='C.';
LI.SubItems.Add('C.');
LI.SubItems.Add('0');
LI.SubItems.Add(Copy(varSElemento,1,20));
LI.SubItems.Add('-1');
LI.SubItems.Add(DateToStr(Now));
end;
end;
procedure TFRutas.SpeedButton1Click(Sender: TObject);
//------------------------------------------------------------------------------
//****************************************************************[ Buscar ]****
//------------------------------------------------------------------------------
var variNumdoc:Integer;
LI : TListItem;
begin //Primero Totas de entrega
ActQuery(IbqbusDoc,'SELECT * FROM DOCUMENTOS WHERE ((NUMERORUTA < '+QuotedStr('1')+') OR (NUMERORUTA <> '+QuotedStr('-1')+') OR (NUMERORUTA IS NULL)) AND (DOCUMENTOS.FECHA BETWEEN '+
QuotedStr(Cambiafecha(DateTimePicker1.Date))+' AND '+QuotedStr(Cambiafecha(DateTimePicker2.Date))+
') ORDER BY DOCUMENTOS.NUMERODOCUMENTO',True,True,False);
ListView1.Clear;
if not IbqbusDoc.IsEmpty then
begin
IbqbusDoc.First;
while not IbqbusDoc.Eof do
begin
LI:=ListView1.Items.Add;
LI.Caption:='';
LI.SubItems.Add(IbqbusDocTIPODOCUMENTO.AsString);
LI.SubItems.Add(IbqbusDocSERIE.AsString);
LI.SubItems.Add(IbqbusDocNUMERODOCUMENTO.Value);
LI.SubItems.Add(IbqbusDocCODIGOCLIENTE.Value);
LI.SubItems.Add(DateToStr(IbqbusDocFECHA.Value));
LI.SubItems.Add(IbqbusDocTOTALPESO.AsString);
IbqbusDoc.Next;
end;
end;
Panel3.Visible:=True;
if DM.IBDCONFINUMERORUTA.IsNull then variNumdoc:=1
else variNumdoc:=SoloInteger(DM.IBDCONFINUMERORUTA.Value)+1;
Label8.Caption:=IntToStr(VarINumDoc);
if ListView1.Items.Count >0 then PosiListView(ListView1,0);
end;
procedure TFRutas.SpeedButton2Click(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Copiar 1 elemento ]****
//------------------------------------------------------------------------------
var Item, LI: TListItem;
begin
if ListView1.ItemIndex<>-1 then
begin
Item := ListView1.Items.Item[ListView1.ItemIndex];
LI:=ListView2.Items.Add;
LI.Caption:=Item.Caption;
LI.SubItems.Add(Item.SubItems[0]);
LI.SubItems.Add(Item.SubItems[1]);
LI.SubItems.Add(Item.SubItems[2]);
LI.SubItems.Add(Item.SubItems[3]);
LI.SubItems.Add(Item.SubItems[4]);
LI.SubItems.Add(Item.SubItems[5]);
ListView1.Items.Delete(ListView1.ItemIndex);
if ListView1.Items.Count>0 then ListView1.ItemIndex:=0
else ListView2.ItemIndex:=ListView2.Items.Count-1;
end;
end;
procedure TFRutas.SpeedButton3Click(Sender: TObject);
//------------------------------------------------------------------------------
//*********************************************[ Copiar todos los elemento ]****
//------------------------------------------------------------------------------
var Item, LI: TListItem;
VarIContFor:Integer;
begin
if ListView1.ItemIndex<>-1 then
begin
for VarIContFor := 1 to ListView1.Items.Count do
begin
Item := ListView1.Items.Item[0];
LI:=ListView2.Items.Add;
LI.Caption:=Item.Caption;
LI.SubItems.Add(Item.SubItems[0]);
LI.SubItems.Add(Item.SubItems[1]);
LI.SubItems.Add(Item.SubItems[2]);
LI.SubItems.Add(Item.SubItems[3]);
LI.SubItems.Add(Item.SubItems[4]);
LI.SubItems.Add(Item.SubItems[5]);
ListView1.Items.Delete(ListView1.ItemIndex);
if ListView1.Items.Count>0 then ListView1.ItemIndex:=0
else ListView2.ItemIndex:=ListView2.Items.Count-1;
end;
ListView2.ItemIndex:=0;
end;
end;
procedure TFRutas.SpeedButton4Click(Sender: TObject);
//------------------------------------------------------------------------------
//*****************************************************[ Copiar 1 elemento ]****
//------------------------------------------------------------------------------
var Item, LI: TListItem;
begin
if ListView2.ItemIndex<>-1 then
begin
Item := ListView2.Items.Item[ListView2.ItemIndex];
LI:=ListView1.Items.Add;
LI.Caption:=Item.Caption;
LI.SubItems.Add(Item.SubItems[0]);
LI.SubItems.Add(Item.SubItems[1]);
LI.SubItems.Add(Item.SubItems[2]);
LI.SubItems.Add(Item.SubItems[3]);
LI.SubItems.Add(Item.SubItems[4]);
LI.SubItems.Add(Item.SubItems[5]);
ListView2.Items.Delete(ListView2.ItemIndex);
if ListView2.Items.Count>0 then ListView2.ItemIndex:=0
else ListView1.ItemIndex:=ListView1.Items.Count-1;
end;
end;
procedure TFRutas.SpeedButton5Click(Sender: TObject);
//------------------------------------------------------------------------------
//********************************************[ Copiar Todos los elementos ]****
//------------------------------------------------------------------------------
var Item, LI: TListItem;
varIcontFort:Integer;
begin
if ListView2.ItemIndex<>-1 then
begin
for varIcontFort := 1 to ListView2.Items.Count do
begin
Item := ListView2.Items.Item[0];
LI:=ListView1.Items.Add;
LI.Caption:=Item.Caption;
LI.SubItems.Add(Item.SubItems[0]);
LI.SubItems.Add(Item.SubItems[1]);
LI.SubItems.Add(Item.SubItems[2]);
LI.SubItems.Add(Item.SubItems[3]);
LI.SubItems.Add(Item.SubItems[4]);
LI.SubItems.Add(Item.SubItems[5]);
ListView2.Items.Delete(ListView2.ItemIndex);
if ListView2.Items.Count>0 then ListView2.ItemIndex:=0
else ListView1.ItemIndex:=ListView1.Items.Count-1;
end;
ListView1.ItemIndex:=0;
end;
end;
procedure TFRutas.SpeedButton6Click(Sender: TObject);
//------------------------------------------------------------------------------
//************************************************************[ Crear ruta ]****
//------------------------------------------------------------------------------
var VariCont3ForNotas:Integer;
Item, LI: TListItem;
begin
Try
if Panel3.Visible then
begin
if CBEmpleados.Text<>'' then
begin
if CBVehiculos.Text<>'' then
begin
if ListView2.Items.Count>0 then //Si el listview es mayor que 0
begin
for VariCont3ForNotas := 0 to ListView2.Items.Count -1 do //Contador del listview
begin
Item := ListView2.Items.Item[VariCont3ForNotas];
DsRutas.DataSet.Insert;
DsRutas.DataSet.FieldByName('TIPODOCUMENTO').Value:=Item.SubItems[0];
DsRutas.DataSet.FieldByName('NUMERORUTA').Value:=StrToInt(Label8.Caption);
DsRutas.DataSet.FieldByName('SERIE').Value:=Item.SubItems[1];
DsRutas.DataSet.FieldByName('NUMERODOCUMENTO').Value:=Item.SubItems[2];
DsRutas.DataSet.FieldByName('FECHA').Value:=DateTimePicker3.Date;
DsRutas.DataSet.FieldByName('CODIGOCLIENTE').Value:=Item.SubItems[3];
DsRutas.DataSet.FieldByName('PESO').Value:=Item.SubItems[5];
DsRutas.DataSet.FieldByName('MATRICULA').Value:=EliminaRestoCadena(CBVehiculos.Text,';');
DsRutas.DataSet.FieldByName('CODIGOEMPLEADO').Value:=EliminaRestoCadena(CBEmpleados.Text,';');
if DsBusCli.DataSet.Locate('CODIGO',Item.SubItems[3],[loCaseInsensitive,loPartialKey]) then
begin
DsRutas.DataSet.FieldByName('NOMBRECLIENTE').Value:=IBQbuscliNOMBRE.Value;
end else
begin
DsRutas.DataSet.FieldByName('NOMBRECLIENTE').Value:=Item.SubItems[2];
end;
if DsRutas.DataSet.State in [dsEdit,dsInsert] then DsRutas.DataSet.Post;
if DsDocumentos.DataSet.Locate('TIPODOCUMENTO;NUMERODOCUMENTO;SERIE',VarArrayOf([Item.SubItems[0],Item.SubItems[2],Item.SubItems[1]]),[loCaseInsensitive,loPartialKey]) then
begin
DsDocumentos.DataSet.Edit;
DsDocumentos.DataSet.FieldByName('FECHAENTREGA').Value:=DateTimePicker3.Date;
DsDocumentos.DataSet.FieldByName('NUMERORUTA').Value:=StrToInt(Label8.Caption);
if DsDocumentos.DataSet.State in [dsEdit,dsInsert] then DsDocumentos.DataSet.Post;
end;
end;
DM.IBDCONFI.Edit;
if DM.IBDCONFINUMERORUTA.IsNull then DM.IBDCONFINUMERORUTA.Value:='1'
else DM.IBDCONFINUMERORUTA.Value:=IntToStr(SoloInteger(DM.IBDCONFINUMERORUTA.Value)+1);
if DM.IBDCONFI.State in [dsEdit,dsInsert] then DM.IBDCONFI.Post;
DM.IBTransaction1.CommitRetaining;
ShowMessage('La ruta ha sido creada');
ListView1.Clear;
ListView2.Clear;
if CheckBox1.Checked then
begin
//------------------------------------------------------------------------------
//************************************************************[ IMPRIME ]*******
// Muestra directamente este reporte
//------------------------------------------------------------------------------
// TENER EN CUENTA SUMAR TODO EL PESO
end;
end;
end else ShowMessage('Debe seleccionar el vehículo');
end else ShowMessage('Debe seleccionar el empleado');
end else ShowMessage('Pulse bucar, para asignar un número de ruta');
except
on E: Exception do
begin
MessageBeep(1000);
ShowMessage(
'Se ha producido un error y el proceso no se ha podido terminar Unidad:[ uRutas ] 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');
DM.IBTransaction1.RollbackRetaining;
end;
end;
end;
procedure TFRutas.SpeedButton7Click(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************************[ Subir 1 ]****
// Sube 1 elemento en el listview
//------------------------------------------------------------------------------
begin
if ListView1.Selected.Index>0 then PosiListView(ListView1,ListView1.Selected.Index-1); //Este sube al elemento anterior
end;
procedure TFRutas.SpeedButton8Click(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************************[ Bajar 1 ]****
// Baja 1 elemento en el listview
//------------------------------------------------------------------------------
begin
if ListView1.Selected.Index<ListView1.Items.Count-1 then PosiListView(ListView1,ListView1.Selected.Index+1); //Este baja al siguiente registro
end;
procedure TFRutas.SpeedButton9Click(Sender: TObject);
//------------------------------------------------------------------------------
//***************************************************************[ Bajar 1 ]****
// Baja 1 elemento en el listview
//------------------------------------------------------------------------------
begin
if ListView2.Selected.Index<ListView2.Items.Count-1 then PosiListView(ListView2,ListView2.Selected.Index+1); //Este baja al siguiente registro
end;
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment