Copiar diretorio com todos os arquivos trocando os formato

Delphi

18/01/2004

Alo pessoal...

como faço pra copiar um diretorio de um CD-ROM com arquivos no formato BMP...para um diretorio no HD trocando o formato das imagens para JPG..conservando o mesmo nome de cada arquivo trocando apenas os formatos de BMP para JPG

desde já agradeço muito


Mcfccna

Mcfccna

Curtidas 0

Respostas

Fabio.hc

Fabio.hc

18/01/2004

Tente assim:

procedure TForm1.Button1Click(Sender: TObject);
var
  SR: TSearchRec;
  I: integer;
  Origem, Destino: string;
begin
  I := FindFirst(´c:\Origem\*.bmp´, faAnyFile, SR);
  while I = 0 do begin
    if (SR.Attr and faDirectory) <> faDirectory then begin
      Origem := ´c:\Origem\´ + SR.Name;
      Destino:= copy(SR.Name,1,POS(ExtractFileExt(SR.Name),SR.Name));
      Destino := ´c:\Destino\´ + Destino + ´jpg´;
      if not CopyFile(PChar(Origem), PChar(Destino), true) then
        ShowMessage(´Erro ao copiar ´ + Origem + ´ para ´ + Destino);
    end;
    I := FindNext(SR);
  end;
end;


Esta rotina apenas troca a extensão mantendo o jpg do mesmo tamanho que o bmp, se quiser diminuir o tamanho do jpg vc terá que converter bmp para jpg, eu tenho outra rotina para converter:

procedure TForm2.Button1Click(Sender: TObject);
var
  SR: TSearchRec;
  I: integer;
   MyBMP : TBitmap;
begin
   I := FindFirst(´c:\Origem\*.*´, faAnyFile, SR);
   while I = 0 do
      begin
      if (SR.Attr and faDirectory) <> faDirectory then
         begin
         Origem := ´c:\Origem\´ + SR.Name;

         MyBMP := TBitmap.Create;
         try
         MyBMP.LoadFromFile(Origem);


         Destino:= copy(SR.Name,1,POS(ExtractFileExt(SR.Name),SR.Name));
         Destino := ´c:\Destino\´ + Destino + ´jpg´;

         if not FileExists(Destino) then
            BmpToJpg(MyBMP);

         finally
         MyBMP.Free;
         end;

         end;
      I := FindNext(SR);
      end;
end;

function TForm2.BmpToJpg(cImage: tbitmap): Boolean;
var
  jp: TJpegImage;
begin
   jp := TJpegImage.Create;
   try
      with jp do
      begin
      Assign(cImage);
      SaveToFile(Destino)
      end;
   finally
      jp.Free;
   end;
end;



GOSTEI 0
Mcfccna

Mcfccna

18/01/2004

cara!
vou implementar o procedimento no meu programa e obrigado...é isso mesmo que estava querendo...grato

manoel
se funcionar legal volto a entrar em contato


GOSTEI 0
POSTAR