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

Respuesta
 
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
  #2  
Antiguo 15-09-2007
Avatar de paldave
paldave paldave is offline
Miembro
 
Registrado: ago 2007
Ubicación: Uruguay
Posts: 148
Poder: 17
paldave Va por buen camino
Pues me tomé 1 hora y a las conclusiones que llegué fueron:
1) el código que pones no compila
2) esto se debe a que faltan declaraciones como por ejemplo el valor de
DBT_DEVICEARRIVAL (buscando en la documentación encontré que const DBT_DEVICEARRIVAL =32806)
3) faltan además procedimientos que se llaman desde este código (ej.: RellenarFotos) y variables (ej.: cantidades)

Conclusión general: si quieres ayuda pon más cuidado en como planteas tus preguntas. Si puedes poner todo el código de la unidad sería de mucha ayuda. Saludos.
Responder Con Cita
  #3  
Antiguo 17-09-2007
kapullok_2006 kapullok_2006 is offline
Miembro
 
Registrado: mar 2007
Posts: 90
Poder: 18
kapullok_2006 Va por buen camino
Red face pondré el código de Unit1

Hola, pongo aquí el código de Unit1.

<DIV class=frame_codigo_delphi>Código Delphi [-]<DIV class=texto_codigo_delphi id=delphi_div_46ee3635ce090>
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons,JPeg;
type
TForm1 = class(TForm)
Image0: TImage;
Memo1: TMemo;
Image1: TImage;
Image2: TImage;
Image3: TImage;
Image4: TImage;
Image5: TImage;
Image6: TImage;
Fotos_ant: TBitBtn;
Fotos_sgtes: TBitBtn;
Cerrar: TButton;
procedure Image1Click(Sender: TObject);
procedure Image2Click(Sender: TObject);
procedure Image3Click(Sender: TObject);
procedure Image4Click(Sender: TObject);
procedure Image5Click(Sender: TObject);
procedure Image6Click(Sender: TObject);
procedure Fotos_antClick(Sender: TObject);
procedure Fotos_sgtesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
// procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
// procedure FormDestroy(Sender: TObject);
procedure CerrarClick(Sender: TObject);
private
{ Private declarations }
procedure WMDEVICECHANGE(var Msg: TMessage); message WM_DEVICECHANGE;

public
{ Public declarations }
end;
var
Form1: TForm1;
lista_archivos: TStringList;
i: integer;
cantidades: TStringList;
offset: integer =0;
//AÑadido 11 Sept
lista_aux:TStringList;
{ MyJPEG : TJPEGImage;
MyBMP : TBitmap;
var jpg,bmp:string;
}
implementation
{$R *.dfm}
uses Unit2;
const foto_en_blanco = 'C:\foto_en_blanco.bmp';
const
DBT_DEVICEARRIVAL = $8000; //esto es algo que me pusieron en club delphi
//------------------------------------------------------------------------------

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
procedure RellenarFotos(f: integer); forward;
procedure RellenarFotos(f: integer);
begin
//si posicion es < q lineas-> cargamos en Image1 el directory metido de la posicion de FLB1

if f
Responder Con Cita
  #4  
Antiguo 17-09-2007
kapullok_2006 kapullok_2006 is offline
Miembro
 
Registrado: mar 2007
Posts: 90
Poder: 18
kapullok_2006 Va por buen camino
Red face pondré el código de Unit1

Hola, pongo aquí el código de Unit1.

<DIV class=frame_codigo_delphi><DIV class=texto_codigo_delphi id=delphi_div_46ee3635ce090>
[delphi]unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons,JPeg;
type
TForm1 = class(TForm)
Image0: TImage;
Memo1: TMemo;
Image1: TImage;
Image2: TImage;
Image3: TImage;
Image4: TImage;
Image5: TImage;
Image6: TImage;
Fotos_ant: TBitBtn;
Fotos_sgtes: TBitBtn;
Cerrar: TButton;
procedure Image1Click(Sender: TObject);
procedure Image2Click(Sender: TObject);
procedure Image3Click(Sender: TObject);
procedure Image4Click(Sender: TObject);
procedure Image5Click(Sender: TObject);
procedure Image6Click(Sender: TObject);
procedure Fotos_antClick(Sender: TObject);
procedure Fotos_sgtesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
// procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
// procedure FormDestroy(Sender: TObject);
procedure CerrarClick(Sender: TObject);
private
{ Private declarations }
procedure WMDEVICECHANGE(var Msg: TMessage); message WM_DEVICECHANGE;

public
{ Public declarations }
end;
var
Form1: TForm1;
lista_archivos: TStringList;
i: integer;
cantidades: TStringList;
offset: integer =0;
//AÑadido 11 Sept
lista_aux:TStringList;
{ MyJPEG : TJPEGImage;
MyBMP : TBitmap;
var jpg,bmp:string;
}
implementation
{$R *.dfm}
uses Unit2;
const foto_en_blanco = 'C:\foto_en_blanco.bmp';
const
DBT_DEVICEARRIVAL = $8000; //esto es algo que me pusieron en club delphi
//------------------------------------------------------------------------------

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
procedure RellenarFotos(f: integer); forward;
procedure RellenarFotos(f: integer);
begin
//si posicion es < q lineas-> cargamos en Image1 el directory metido de la posicion de FLB1

if f
Responder Con Cita
  #5  
Antiguo 17-09-2007
kapullok_2006 kapullok_2006 is offline
Miembro
 
Registrado: mar 2007
Posts: 90
Poder: 18
kapullok_2006 Va por buen camino
Aqui está:

<DIV class=frame_codigo_delphi><DIV class=texto_codigo_delphi id=delphi_div_46ee3bb322ba9>
[delphi]
<SPAN class=comment>//..

private

{ Private declarations }

procedure WMDEVICECHANGE(var Msg: TMessage); message WM_DEVICECHANGE;



public

{ Public declarations }

end;

var

Form1: TForm1;

lista_archivos: TStringList;

i: integer;

cantidades: TStringList;

offset: integer =0;

//AÑadido 11 Sept

lista_aux:TStringList;



implementation

{$R *.dfm}

uses Unit2;

const foto_en_blanco = 'C:\foto_en_blanco.bmp';

const

DBT_DEVICEARRIVAL = $8000;

//----------------------------------------------

procedure RellenarFotos(f: integer); forward;

procedure RellenarFotos(f: integer);

begin

//si posicion es < q lineas-> cargamos en Image1 el directory metido de la posicion de FLB1


if f
Responder Con Cita
  #6  
Antiguo 17-09-2007
kapullok_2006 kapullok_2006 is offline
Miembro
 
Registrado: mar 2007
Posts: 90
Poder: 18
kapullok_2006 Va por buen camino
para paldave

lo siento pero,por algun error no puedo ponerte el unit1,la única forma
de que lo veas es decirme tu correo,para que puedas verlo todo.

Saludos.
Responder Con Cita
  #7  
Antiguo 17-09-2007
kapullok_2006 kapullok_2006 is offline
Miembro
 
Registrado: mar 2007
Posts: 90
Poder: 18
kapullok_2006 Va por buen camino
Código Delphi [-]
var
  Form1: TForm1;
  lista_archivos: TStringList;
  i: integer;
  cantidades: TStringList;
  offset: integer =0;
implementation
{$R *.dfm}
uses Unit2;
const foto_en_blanco = 'C:\foto_en_blanco.bmp';
const
  DBT_DEVICEARRIVAL = $8000;
 
procedure RellenarFotos(f: integer); forward;
procedure RellenarFotos(f: integer);
begin
     //si posicion es < q lineas-> cargamos en Image1 el directory metido de la posicion de FLB1
       if fthen
       begin
          Form1.Image1.Picture.LoadFromFile(Form1.Memo1.Lines.Strings[f]);
       end
       else
       begin
         Form1.Image1.Picture.LoadFromFile(foto_en_blanco);
       end;
       if f+1then
       begin
          Form1.Image2.Picture.LoadFromFile(Form1.Memo1.Lines.Strings[f+1]);
       end
       else
       begin
          Form1.Image2.Picture.LoadFromFile(foto_en_blanco);
       end;
       if f+2then
       begin
         Form1.Image3.Picture.LoadFromFile(Form1.Memo1.Lines.Strings[f+2]);
       end
       else
       begin
         Form1.Image3.Picture.LoadFromFile(foto_en_blanco);
       end;
       if f+3then
       begin
         Form1.Image4.Picture.LoadFromFile(Form1.Memo1.Lines.Strings[f+3]);
       end
       else
       begin
         Form1.Image4.Picture.LoadFromFile(foto_en_blanco);
       end;
       if f+4then
       begin
         Form1.Image5.Picture.LoadFromFile(Form1.Memo1.Lines.Strings[f+4]);
       end
       else
       begin
         Form1.Image5.Picture.LoadFromFile(foto_en_blanco);
       end;
       if f+5then
       begin
          Form1.Image6.Picture.LoadFromFile(Form1.Memo1.Lines.Strings[f+5]);
       end
       else
       begin
         Form1.Image6.Picture.LoadFromFile(foto_en_blanco);
       end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  cantidades:= TStringList.Create; //crea el StringList 'cantidades'
 lista_archivos:=TStringList.Create;
 //añadido 11 Sept
 lista_aux:=TStringList.Create;
end;
Responder Con Cita
  #8  
Antiguo 18-09-2007
Avatar de paldave
paldave paldave is offline
Miembro
 
Registrado: ago 2007
Ubicación: Uruguay
Posts: 148
Poder: 17
paldave Va por buen camino
Puedes poner el form y su unit en un zip y adjuntarlo al mensaje usando el botón Gestionar Archivos Adjuntos al pie de Responder Mensaje
Responder Con Cita
  #9  
Antiguo 20-09-2007
kapullok_2006 kapullok_2006 is offline
Miembro
 
Registrado: mar 2007
Posts: 90
Poder: 18
kapullok_2006 Va por buen camino
Red face

por alguna razón,estoy conectado a un servidor proxy.Por lo que es que no
puedo adjuntar el archivo zip.La 1ª vez,q me contestaste,me dijiste que no sabías lo que era RellenarFotos() y variables como cantidades.
EStá puesto,en la anterior respuesta a la última q me has contestado.
Intentaré enviarte el archivo zip,pero eso debe ser en otro sitio diferente
al servidor al q me conecto.Esto puede llevarme 1 semana.

Saludos.
NOTA:retocaré,el código,para q me pueda caber el Unit1,que deseas ver.
Pues haber si así,me muestra el código correctamente.
Responder Con Cita
  #10  
Antiguo 25-09-2007
kapullok_2006 kapullok_2006 is offline
Miembro
 
Registrado: mar 2007
Posts: 90
Poder: 18
kapullok_2006 Va por buen camino
Smile para paldave y cualquier otro

De momento te envío,el Unit1 del proyecto,pues creo que con eso es suficiente.

en el memo1 de Form1,no me muestra la ruta donde se encuentra
las fotos q visualizo en los TImage.Es decir,lo que quiero es que
las fotos cargadas de una unidad extraible,como es por ejemplo
la G:\,se guarden en c:\fotos con extension bmp.Si la foto no es
bmp,hay que convertirla a bmp.Pues en el Memo1 ,no muestra,por ejemplo:
c:\fotos\foto1.bmp
c:\fotos\yo.bmp
...
Hay componentes como el TProeffectImage, y TZoom,que son descargados
de www.torry.net en la sección VCL.Aunque para mi pregunta,
no es necesario entenderlos o instalarlos.
Ya sabéis,mi problema radica en el Memo1 del Unit1.

NOta:ES posible que haya código comentado que no valga para nada.
Intentaré acortar el tamaño del Proyecto para poder enviarlo todo.
Saludos.

Última edición por kapullok_2006 fecha: 27-10-2007 a las 11:32:44.
Responder Con Cita
Respuesta



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 03:50:40.


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