Aquí va la solución.
Sirve para copiar pegar desde el Portapapeles un fichero (por ejemplo seleccionado desde el explorador de WIndows) que contenga una imagen tipo JPG o BMP.
Código Delphi
[-]
...
var
f : TFileStream;
Jpg : TJpegImage;
Hand : THandle;
Buffer : Array [0..MAX_PATH] of Char;
numFiles : Integer;
File_Name : String;
Jpg_Bmp : String;
BitMap : TBitMap;
ImageAux : TImage;
begin
ImageAux := TImage.Create(Self);
if Clipboard.HasFormat(CF_HDROP) then begin
Clipboard.Open;
try
Hand := Clipboard.GetAsHandle(CF_HDROP);
If Hand <> 0 then begin
numFiles := DragQueryFile(Hand, $FFFFFFFF, nil, 0) ;
if numFiles > 1 then begin
Clipboard.Close;
ImageAux.Free;
MessageError('El Portapapeles contiene más de un único fichero. No es posible pegar');
Exit;
end;
Buffer[0] := #0;
DragQueryFile( Hand, 0, buffer, sizeof(buffer)) ;
File_Name := buffer;
end;
finally
Clipboard.close;
end;
f := TFileStream.Create(File_Name, fmOpenRead);
Jpg := TJpegImage.Create;
Bitmap := TBitmap.Create;
try
Jpg.LoadFromStream(f);
ImageAux.Picture.Assign(Jpg);
Jpg_Bmp := 'JPG';
except
f.seek(0,soFromBeginning);
Jpg_Bmp := '';
end;
if Jpg_Bmp = '' then begin
try
Bitmap.LoadFromStream(f);
Jpg.Assign(Bitmap);
ImageAux.Picture.Assign(Jpg);
Jpg_Bmp := 'BMP';
except
Jpg_Bmp := '';
end;
end;
Jpg.Free;
Bitmap.Free;
f.Free;
if Jpg_Bmp = '' then begin
ImageAux.Free;
MessageError('Fichero seleccionado no contiene ninguna Imagen del Tipo JPEG o BMP');
Exit;
end;
end
else if Clipboard.HasFormat(CF_BITMAP) then
ImageAux.Picture.Assign(Clipboard)
else begin
ImageAux.Free;
MessageError('El Portapapeles no contiene ninguna Imagen del Tipo JPEG o BMP');
Exit;
end;
Jpg := TJpegImage.Create;
try
Jpg.Assign(ImageAux.Picture.Graphic);
except
ImageAux.Free;
MessageError('El Portapapeles no contiene ninguna Imagen del Tipo JPEG o BMP');
Jpg.Free;
Exit;
end;
Jpg.Free;
Image1.Picture.Assign(ImageAux.Picture);
Hago uso de ImageAux (de tipo TImage) para comprobar previamente la validez del contenido del portapapeles.
He hecho pruebas con varios programas (Adobe Acrobat, Word, Excel, ...) y la mayoría de ellos permiten que ImageAux.Picture.Assign(Clipboard) funcione, que se asigne una especie de 'Imagen' del contenido del portapapeles a un TImage.
Pero realmente no se trata en sí mismo, de un JPG o BMP, y es por ello que en operaciones posteriores daría error.
Quiero indicar que MessageError es una rutina propia, que muestra el error en pantalla. Y los diferentes 'Exit' los he dejado también tal cual ya que lo mostrado es parte de una rutina más amplia.
En el uses de la unit, aparte de otros, debereis incluid ClipBrd y JPEG.
Saludos y espero a alquien le pueda servir
