Lenguaje de programación Borland Delphi
A esta función de Delphi se le pasa como parámetro un fichero origen (ruta y nombre de fichero) y un fichero destino (ruta y nombre de fichero) y copia el fichero origen en el destino. Si en el destino existe un fichero con el mismo nombre añadirá un número al final del nomber de fichero destino para no reemplazarlo. Esta función devolverá el nombre del fichero destino resultante:
function copiarImagenDespiece (ficheroOrigen, ficheroDestino : string) : string;
var
i : integer;
begin
result := '';
i := 1;
while FileExists (ficheroDestino) do
begin
ficheroDestino := ChangeFileExt(ExtractFileName (ficheroOrigen), '') +
IntToStr(i);
ficheroDestino := IncludeTrailingPathDelimiter(vtRutaDespieces) +
ficheroDestino + ExtractFileExt(ficheroOrigen);
Inc(i);
end;
if CopyFile (pchar(ficheroOrigen), pchar (ficheroDestino), true) then
result := ExtractFileName (ficheroDestino)
else
result := '';
end;
Un ejemplo de utilización:
procedure TformAgregarPiezaDespiece.AceptarDespieceClick(Sender: TObject);
var
nombreFicheroDestino : string;
begin
if dm.tDespiecesSelPieza.State = dsEdit then
dm.tDespiecesSelPieza.Post;
dm.TC3.Close;
dm.TC3.SQL.Clear;
dm.TC3.SQL.Add('SELECT Nombre FROM ' + vtTablaDespieces +
' WHERE upper(Nombre) = :pNombre');
dm.TC3.ParamByName ('pNombre').DataType := ftString;
dm.TC3.ParamByName ('pNombre').Value := AnsiUpperCase(EditNombre.Text);
dm.TC3.Open;
if (EditNombre.Text = '') or (dm.TC3.RecordCount > 0) then
begin
MessageDlg ('El nombre intruducido para el despiece no es válido o ya existe.' +
#13 + 'Pruebe con otro o pulse [ESC] para cancelar.',
mtWarning, [mbok], 0);
EditNombre.SetFocus;
end
else
begin
if codigoProveedor = 0 then
begin
MessageDlg('Debe seleccionar un proveedor para el despiece.',
mtWarning, [mbok], 0);
Proveedor.SetFocus;
end
else
begin
with formDespieceImagen do
begin
if vtOrigenImagenEscaner then
nombreFicheroDestino := vtRutaDespieces + EditNombre.Text +
ExtractFileExt (EditImagen.Text)
else
nombreFicheroDestino := vtRutaDespieces + ExtractFileName (EditImagen.Text);
nombreFicheroDestino := copiarImagenDespiece (EditImagen.Text, nombreFicheroDestino);
if nombreFicheroDestino = '' then
MessageDlg ('Ha habido un error al copiar la imagen del despiece en la ruta: ' +
chr(13) + chr(13) + vtRutaDespieces + chr(13) + chr(13) +
'Compruebe que dicha ruta existe.',
mtWarning, [mbok], 0)
else
begin
{eliminamos la imagen del despiece si ha sido escaneada}
if vtEliminarImagenesEscaneadas and vtOrigenImagenEscaner then
DeleteFile(EditImagen.Text);
dm.tDespiecesSelPieza.Insert;
dm.tDespiecesSelPiezaCodigo.Value := generarCodigoAuto(vtTablaDespieces);
dm.tDespiecesSelPiezaNombre.Value := EditNombre.Text;
dm.tDespiecesSelPiezaDescripcion.Value := EditDescripcion2.Text;
dm.tDespiecesSelPiezaCodigoProveedor.Value := codigoProveedor;
dm.tDespiecesSelPiezaImagen.Value := ExtractFileName (nombreFicheroDestino);
dm.tDespiecesSelPieza.Post;
dm.TPieza.Insert;
dm.TPiezaCodigo.Value := generarCodigoAuto(vtTablaPiezas);
dm.TPiezaCodigoDespiece.Value := dm.tDespiecesSelPiezaCodigo.Value;
dm.TPiezaCodigoUsuario.Value := EditCodigo.Text;
dm.TPiezaDescripcion.Value := EditDescripcion.Text;
dm.TPiezaPrecioCompra.Value := StrToFloat(EditPrecioCompra.Text);
dm.TPiezaPrecioVenta.Value := StrToFloat(EditPrecioVenta.Text);
dm.TPiezaStock.Value := strtofloat(EditStock.Text);
dm.TPiezaStokMinimo.Value := strtofloat(EditStockMinimo.Text);
dm.TPiezaCodigoDeBarras.Value := EditCodigoDeBarras.Text;
dm.TPiezaEstanteria.Value := EditEstanteria.Text;
dm.TPiezaLeja.Value := EditLeja.Text;
dm.TPiezaX1.Value := StrToInt(LIzquierda.Caption);
dm.TPiezaX2.Value := StrToInt(LDerecha.Caption);
dm.TPiezaY1.Value := StrToInt(LArriba.Caption);
dm.TPiezaY2.Value := StrToInt(LAbajo.Caption);
dm.tPiezaCodigoProveedor.Value := codigoProveedor;
dm.TPieza.Post;
DBLCBDespieces.KeyValue := dm.tDespiecesSelPiezaCodigo.Value;
DBLCBDespiecesClick(Sender);
formAgregarPiezaDespiece.ModalResult := mrOk;
end;
end;
end;
end;
end;
Publicado el: 2006-02-11