Salvar Imagem

Delphi

22/09/2006

E ai Galera
Estou querendo saber o seguinte tenho um openPictureDialog no formulario e quero copiar a imagem que eu escolhi para para outro diretório e com outro nome pensei em colocar um SavePictureDialog mas só que ele pede o caminho para salvar a imagem, e eu quero que isso sejá feito diréto com o caminho e nome que já vai estar determinado e mesmo se já tiver a figura com o mesmo nome ele apenas sobreescreva a imagem antiga pela atual sem perguntar Tem como eu fazer isso?

Valeu :wink:


Alecsandro Moura

Alecsandro Moura

Curtidas 0

Respostas

Paullsoftware

Paullsoftware

22/09/2006

Eu tenho essa rotina que uso para armazenar a foto dos clientes do meu sistema de locadora que pode lhe ser útil, se poder modificá-la e aperfeiçoá-la compartilhe aqui conosco :wink: 

Procedure TFrmCadClientes.CopiaFoto(Origem, Destino: string;Barra:TGauge);
var
  FromF,ToF: file of byte;
  Buffer: array[0..4096] of char;
  NumRead: Integer;
  FileLength: LongInt;
  NewPath: string;
begin
  // Antes de copiar, verifica se já existe o diretório
  // Caso o diretório não exista, o mesmo vai ser criado
  NewPath := ExtractFilePath(Destino);
  if not DirectoryExists(NewPath) then
  begin
    CreateDir(NewPath);
  end;
  // Copia o arquivo
  // Abre o arquivo de origem e cria o arquivo destino
  AssignFile(FromF, Origem);
  Reset(FromF);
  AssignFile(ToF, Destino);
  ReWrite(ToF);
  FileLength := FileSize(FromF);
  with Barra do
  begin
    Progress := 0;
    MinValue := 0;
    MaxValue := FileLength;
    while FileLength > 0 do
    begin
      BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
      FileLength := FileLength - NumRead;
      BlockWrite(ToF, Buffer[0], NumRead);
      AddProgress(NumRead);
    end;
    CloseFile(FromF);
    CloseFile(ToF);
  end;
end; (* CopiaFoto *)


no evento OnClick do botão faço:
procedure TFrmCadClientes.BtnFotoClick(Sender: TObject);
var
 PathBmp,
 OldName,
 NewName : string;
begin
try
PathBmp := ExtractFileDir(ParamStr(0))+´\fotos\´;
if DM_BANCO.CLIENTES.Active then
if not DM_BANCO.CLIENTES.IsEmpty then
//Requer ExtDlgs na uses
with TOpenPictureDialog.Create(Self) do
  begin
     Filter := ´Arquivos de Imagem|*.bmp;*.jpg;´;
     InitialDir := ExtractFilePath(ParamStr(0));
     DefaultExt := ´.jpg´;
     Title      := ´Abrir Foto´;
     if Execute then
     if FileName <> ´´ then
     if FileExists(FileName) then
       begin
        PathBmp := PathBmp+ExtractFileName(FileName);
        Gauge1.Visible := True;
        //Pego o nome atual da imagem
        OldName := ExtractFileName(FileName);
        NewName := FormatFloat(´0000´,DM_BANCO.CLIENTESCODIGO.AsFloat)+´.jpg´;
        CopiaFoto(pChar(FileName),pChar(PathBmp),Gauge1);
        Gauge1.Visible := False;
        RenameFile(ExtractFilePath(PathBmp)+OldName,ExtractFilePath(PathBmp)+NewName);
        btnEditar.Click;
        DM_BANCO.CLIENTES.FieldByName(´FOTO´).AsString := ExtractFilePath(PathBmp)+NewName;
        FotoCli.Picture.LoadFromFile(ExtractFilePath(PathBmp)+NewName);
        FotoCli.Visible := True;
       end;
  end;
except
On E: Exception do
 MessageDlg(´Erro ao carregar a foto, ´+E.Message,mtError,[mbOK],0);
end;
end;(* FotoDblClick *)


Espero ter ajudado :wink:


GOSTEI 0
Micheus

Micheus

22/09/2006

Estou querendo saber o seguinte tenho um openPictureDialog no formulario e quero copiar a imagem que eu escolhi para para outro diretório e com outro nome ... , e eu quero que isso sejá feito diréto com o caminho e nome que já vai estar determinado e mesmo se já tiver a figura com o mesmo nome ele apenas sobreescreva a imagem antiga pela atual sem perguntar
[b:ed6cedf90a]Alecsandro Moura[/b:ed6cedf90a], o exemplo abaixo faz exatamente isto, só precisa ajustar a questão do caminho pré-determinado e o novo nome do arquivo, já que utilizei o mesmo. O parâmetro False em CopyFile (API Windows) diz para sobrescrever o arquivo caso ele exista.
procedure TForm1.Button2Click(Sender: TObject);
var
  NovoNome :string;
begin
  if OpenPictureDialog1.Execute then
  begin
    NovoNome := ´c:\temp\´+ExtractFileName(OpenPictureDialog1.FileName);
    if not CopyFile(PChar(OpenPictureDialog1.FileName), PChar(NovoNome), False) then
      ShowMessage(´Não foi possível copiar o arquivo.´);
  end;
end;


[]s


GOSTEI 0
POSTAR