Asignar path para guardar imágenes

[ecfisa]

Hola radenf.

pero con el nuevo código por alguna extraña razón me copia todas las subcarpetas del directorio, no importando cúal haya yo seleccionado.

En realidad no es extraño, copiar las subcarpetas es el comportamiento normal de la función SHFileOperation con el flag que le asigne. Fuí yo quién interpreté mal lo que deseabas.

Como te mencioné, no tengo forma de probar con el componente SelectDirectoryDialog, pero usando un TDirectoryListBox para seleccionar el orígen y de este modo funciona correctamente:

Código Delphi [-]
uses ShellApi;

function MakePath(const Cad: string; const aDate: TDate): string;
begin
  Result := Copy(DateToStr(aDate),7,4) + '-' +
            Copy(DateToStr(aDate),4,2) + '-' +
            Copy(DateToStr(aDate),1,2); // (Invierto fecha para mantener órden en nombres de carpeta)
  Result := ExtractFilePath(Application.ExeName)+'Dicom Data\Archivos Dicom\'+
            Result + '\' + Cad + '\';
end;

procedure SHFileCopy(hWndOwner: HWND; const SourceFile, TargetFile: string);
var
  SHFileOpStruct: TSHFileOpStruct;
  Aborted : Bool;
begin
  Aborted := False;
  with SHFileOpStruct do
  begin
    Wnd    := hWndOwner;
    wFunc  := FO_COPY;
    pFrom  := PChar(SourceFile);
    pTo    := PChar(TargetFile);
    fFlags := FOF_NOCONFIRMMKDIR + FOF_FILESONLY +  FOF_SILENT;
    fAnyOperationsAborted := Aborted;
  end;
  try
    SHFileOperation(SHFileOpStruct);
  except
    raise Exception.Create('Error copiando la carpeta');
  end;
end;

procedure TForm1.btnCopiarClick(Sender: TObject);
var
  Origen, Destino: string;
begin
  Origen := DirectoryListBox1.Directory;
  Destino:= MakePath(Edit1.Text, Date)+
            ExtractFileName(ExcludeTrailingPathDelimiter(Origen));
  CreateDirectory(PChar(Destino),0);
  if GetLastError <> ERROR_ALREADY_EXISTS then
    SHFileCopy(Handle, Origen + '\*.*', Destino)
  else
    raise Exception.Create('Directorio existente');
end;

Quité el parámetro aName de la función MakePath ya que creo entender que todos los archivos deben ser copiados. La carpeta se crea previamente a la copia mediante la función CreateDirectory, y agregué el flag FOF_FILESONLY que copia sólo archivos usando el comodín ('*.*') como nombre de archivo.

Ahora queda probarlo con el SelectDirectoryDialog...

Saludos.