Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Gráficos
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

 
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 15-09-2007
kapullok_2006 kapullok_2006 is offline
Miembro
 
Registrado: mar 2007
Posts: 90
Poder: 18
kapullok_2006 Va por buen camino
Unhappy no guarda ficheros bmp en carpeta

Hola,tengo este código:
Código Delphi [-]
 
 procedure FindFiles(StartDir, FileMask: string; recursively: boolean; var FilesList: TStringList);
  const
    //MASK_ALL_FILES = '*.*';
    MASK_ALL_FILES = '*.*';
    CHAR_POINT = '.';
  var
    SR: TSearchRec;
    DirList: TStringList;
    IsFound: Boolean;
    i: integer;
    ext: string;
  begin
    if (StartDir[length(StartDir)] <> '\') then begin
      StartDir := StartDir + '\';
    end;
    // Crear la lista de ficheos en el directorio StartDir (no directorios!)
    IsFound := FindFirst(StartDir + FileMask, faAnyFile - faDirectory, SR) = 0;
    // MIentras encuentre
    while IsFound do  begin
      //FilesList.Add(StartDir + SR.Name);
      ext:= AnsiLowercase(copy(SR.Name,length(SR.Name)-2,3));
      if (ext = 'jpg') or (ext = 'bmp') then
      begin
           FilesList.Add(StartDir + SR.Name);
      end;
      IsFound := FindNext(SR) = 0;
    end;
    FindClose(SR);
    // Recursivo?
    if (recursively) then begin
      // Build a list of subdirectories
      DirList := TStringList.Create;
      // proteccion
      try
        IsFound := FindFirst(StartDir + MASK_ALL_FILES, faAnyFile, SR) = 0;
        while IsFound do
        begin
          if ((SR.Attr and faDirectory) <> 0) and
            (SR.Name[1] <> CHAR_POINT) then
            DirList.Add(StartDir + SR.Name);
          IsFound := FindNext(SR) = 0;
        end;
        FindClose(SR);
        // Scan the list of subdirectories
        for i := 0 to DirList.Count - 1 do
          FindFiles(DirList[i], FileMask, recursively, FilesList);
      finally
        DirList.Free;
      end;
    end;
  end;
 
procedure TForm1.WMDEVICECHANGE(var Msg: TMessage);
var
  Letra: Char;
  n:integer;
  //añadido 11 SEpt
  SR: TSearchRec;
  j,k:integer;
  nombre_fichero,ext:String;
  StartDir, FileMask: string;
  DirList: TStringList;
  IsFound: Boolean;
  imjpg : TJPEGImage;
  imbmp  : TBitmap;
  pos:Pchar;
  nombre:String;
  
const   CHAR_POINT = '.';
begin
  if Msg.WParam = DBT_DEVICEARRIVAL  then
  begin
       for Letra:= 'C' to 'Z' do
       begin
            if (GetDriveType(Pchar(Letra+':\')) = DRIVE_REMOVABLE) or (GetDriveType(Pchar(Letra+':\')) = DRIVE_CDROM) then
            begin
                 FindFiles(Letra+':\','*.*',true,lista_archivos);
 
 
                 for j:=0 to lista_archivos.Count-1 do
                 begin
                      for k:=0 to lista_aux.Count-1 do
                      begin
                           ext:= AnsiLowercase(copy(lista_archivos.Strings[j],length(lista_archivos.Strings[j])-2,3));
                           if (ext='bmp') then
                           begin
                              pos:=StrRScan(lista_archivos.FieldAddress(lista_archivos.Strings[j]),'\');
                              pos:=pos+1;
                              while(pos <'p') do
                              begin
                                nombre:=copy(pos,length(pos),1);
                                pos:=pos+1;
                              end;
                              if pos='p' then
                              begin
                                nombre:=copy(pos,length(pos),1);
                              end;
                              imbmp := TBitmap.Create;
                              Width := imjpg.Width;
                              Height := imjpg.Height;
                              Canvas.Draw(0,0,imjpg);
                              imbmp.LoadFromFile(nombre);
                              imbmp.SaveToFile('C:\FOTOS\'+nombre);
                              Free;
                           end
                           else if(ext='jpg') then
                           begin
                              pos:=StrRScan(lista_archivos.FieldAddress(lista_archivos.Strings[j]),'\');
                              pos:=pos+1;
                              while(pos<'j') do
                              begin
                                nombre:=copy(pos,length(pos),1);
                                pos:=pos+1;
                              end;
                              if pos='j' then
                              begin
                                imbmp := TBitmap.Create;
                                Width := imjpg.Width;
                                Height := imjpg.Height;
                                Canvas.Draw(0,0,imjpg);
                                imbmp.LoadFromFile(nombre+'bmp');
                                imbmp.SaveToFile('C:\FOTOS\'+nombre);
                                Free;
                              end;
 
                      end;

                 end;

                 FindFiles('C:\FOTOS\','*.*',true,lista_archivos);
              //  FindFiles('C:\FOTOS\','*.*',true,lista_aux);
                 
                 Memo1.Lines.Assign(lista_archivos);
                 Memo1.Update;
 
               if Memo1.Lines.Count>0 then
               begin
                   i:=0;
                   RellenarFotos(i);
                   cantidades.Clear;
                   for n:=0 to Memo1.Lines.Count-1 do
                   begin
                      cantidades.Add('0');
                   end;
               end;
            end;
       end;
  end;
  inherited;
end;

Pues bien,lo que pasa es que no guarda las fotos bmp y tampoco las
convertidas a bmp, en la carpeta c:\fotos, y tampoco sale en el Memo1,
la ruta del directorio fotos,con los archivos metidos.No sé si me habré equivocado al mover posiciones de lista_archivos.Strings[j].No me queda muy
claro el cómo hacer una vez que encuentres una posicion que quieres,coger
esa y las que correspondan.Por ejemplo:Busco hasta encontrar el último '\',
si lo encuentro salto a la sgte posicion que sería la 1ª letra del nombre fichero.DE esa letra,coger esa hasta el cararcter '.'.Cogería el nombre del archivo más el '.', y despues de éste caracter pondría bmp,si lo que quiero es pasra de jpg a bmp.
Espero,que me podáis decir qué está mal.
Saludos.
Responder Con Cita
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Leer todos los ficheros de una carpeta VRO Varios 9 14-12-2021 11:26:27
Guarda el ADN en la casa jhonny La Taberna 9 05-03-2007 18:22:49
Capturar ruta de acceso a la carpeta mis documentos y a la carpeta activa. Pepe Torres API de Windows 1 23-02-2007 23:02:21
Guarda imágenes metalfox6383 Varios 4 21-08-2005 00:05:19
Por Que No Me Guarda Los Indices? Legolas Conexión con bases de datos 0 17-11-2003 22:37:05


La franja horaria es GMT +2. Ahora son las 09:19:42.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi