Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Gráficos (https://www.clubdelphi.com/foros/forumdisplay.php?f=8)
-   -   Crear imagen en runtime (https://www.clubdelphi.com/foros/showthread.php?t=51898)

salvica 03-01-2008 15:58:14

Crear imagen en runtime
 
Hola a tod@s y Feliz Año Nuevo (solo estamos a 3) :D

Intento copiar una imagen a un fichero Word, el problema es que la imagen me aparece en blanco :confused:

El código que utilizo es el siguiente ( he mezclado TrucoMania con ClubDelphi ;) )
Código Delphi [-]
{
  Esta función localiza un marcador en el documento y "pega" la imagen en su lugar

  parámetros
     Marca -----> es el nombre del marcador (debe existir previamente)
     FileImg ---> el path completo a la imagen
     iHeight ---> la altura que deseo que tenga la imagen (por defecto 100)
     iWidth ----> el ancho  que deseo que tenga la imagen (por defecto 50)
}
Procedure TWordObj.PasteImgToBookMarks( Marca, FileImg:string;
                                        iHeight:integer=100;
                                        iWidth:integer=50 );
var
  Image   : TImage;
  BitMap  : TBitMap;
  Area    : TRect;
  AFormat : Word;
  AData   : THandle;
  APalette: HPALETTE;
  EscalaX : Double;
  EscalaY : Double;
  Escala  : Double;
Begin
  if WordApp.ActiveDocument.Bookmarks.Exists(Marca) then begin
     Image   := TImage.Create( nil );
     try
       with Image do begin
            Autosize := true;
            Picture.LoadFromFile( FileImg );
          { Hallamos la escala de reducción Horizontal }
            if( Widththen EscalaX := Width / iWidth
                else EscalaX := iWidth / Width;
          { La escala vertical }
            if( Heightthen EscalaY := Height / iHeight
                else EscalaY := iHeight / Height;
          { Escogemos la menor de las 2 }
            if( EscalaYthen Escala := EscalaY
                else Escala := EscalaX;
          { Y la usamos para reducir el rectangulo destino }
            with Area do begin
                 Bottom := Trunc(Height * Escala);
                 Left   := 0;
                 Right  := Trunc(Width  * Escala);
                 Top    := 0;
            end;
       end;
     { Dibujamos el TImage en el TBitMap destino con el nuevo tamaño }
       BitMap  := TBitMap.Create;
       with BitMap do begin
            try
            { ajustar el BitMap y copiar la imágen }
              Height := Area.Bottom;
              Width  := Area.Right;
              Canvas.StretchDraw(Area, Image.Picture.Bitmap);
            { guardarlo en el portapapeles }
              SaveToClipboardFormat(AFormat, AData, APalette);
            { copiar el portapapeles en el documento }
              ClipBoard.SetAsHandle(AFormat, AData);
              WordApp.ActiveDocument.Bookmarks.Item(Marca).Range.Paste;
            finally
               free;
            end;
       end;
     finally
       Image.Free;
     end;
  end;
end;
Como digo, el tamaño ajusta perfectamente, pero no tiene imagen. :(

El pegado de la marca trabaja, porque si dejo la imagen a su tamaño original la pega correctamente
Código Delphi [-]

Procedure TWordObj.PasteImgToBookMarks( Marca, FileImg:string );
var
  Image   : TImage;
  AFormat : Word;
  AData   : THandle;
  APalette: HPALETTE;
Begin
  if WordApp.ActiveDocument.Bookmarks.Exists(Marca) then begin
     Image   := TImage.Create( nil );
     try
       with Image do begin
            Picture.LoadFromFile( FileImg );
          { guardarlo en el portapapeles }
            SaveToClipboardFormat(AFormat, AData, APalette);
          { copiar el portapapeles en el documento }
            ClipBoard.SetAsHandle(AFormat, AData);
            WordApp.ActiveDocument.Bookmarks.Item(Marca).Range.Paste;
       end;
     finally
       Image.Free;
     end;
  end;
end;
¿Alguna idea de donde estoy metiendo la pata?
Gracias
Salvador

salvica 03-01-2008 17:58:16

Resuelto
 
Vale, me respondo a mí mismo

Estaba copiando de un "Jpg" y por eso no sacaba nada en el BitMap, la solución consistía en operar sobre Picture.Graphic y no sobre Picture.BitMap como estaba haciendo.

Dejo la función modificada por si le sirve a alguien

Código Delphi [-]
{
  Esta función localiza un marcador en el documento y "pega" la imágen en su lugar

  parámetros
     Marca -----> es el nombre del marcador (debe existir previamente)
     FileImg ---> el path completo a la imágen
     iHeight ---> la altura que deseo que tenga la imágen (por defecto 100)
     iWidth ----> el ancho  que deseo que tenga la imágen (por defecto 50)
}
Procedure TWordObj.PasteImgToBookMarks( Marca, FileImg:string;
                                        iHeight:integer=100;
                                        iWidth:integer=50 );
var
  Image   : TImage;
  BitMap  : TBitMap;
  Area    : TRect;
  AFormat : Word;
  AData   : THandle;
  APalette: HPALETTE;
  EscalaX : Double;
  EscalaY : Double;
  Escala  : Double;
Begin
{ si existe el marcador, operamos sobre la imagen }
  if WordApp.ActiveDocument.Bookmarks.Exists(Marca) then begin
     Imagen  := TImage.Create( Application.MainForm );
     try
       with Imagen do begin
            Autosize := true;
            Visible  := false;
            Picture.LoadFromFile( FileImg );
          { Hallamos la escala de reducción Horizontal }
            if( Width < iWidth )
                then EscalaX := Width / iWidth
                else EscalaX := iWidth / Width;
          { La escala vertical }
            if( Height < iHeight )
                then EscalaY := Height / iHeight
                else EscalaY := iHeight / Height;
          { Escogemos la menor de las 2 }
            if( EscalaY < EscalaX )
                then Escala := EscalaY
                else Escala := EscalaX;
          { Y la usamos para reducir el rectangulo destino }
            with Area do begin
                 Bottom := Trunc(Height * Escala);
                 Left   := 0;
                 Right  := Trunc(Width  * Escala);
                 Top    := 0;
            end;
       end;
     { Dibujamos el TImage en el TBitMap destino con el nuevo tamaño }
       BitMap  := TBitMap.Create;
       with BitMap do begin
            try
            { formateamos el BitMap }
              Height  := Area.Bottom;
              Width   := Area.Right;
            { dibujamos TImage en TBitMap }
              Canvas.StretchDraw(Area, Imagen.Picture.Graphic);
            { guardarlo en el portapapeles }
              SaveToClipboardFormat(AFormat, AData, APalette);
            finally
            { eliminamos de la memoria el TBitMap }
              free;
            end;
       end;
     finally
     { eliminamos de la memoria el TImage }
       Imagen.Free;
     end;
  end;
{ copiar el portapapeles en el documento }
  ClipBoard.SetAsHandle(AFormat, AData);
  WordApp.ActiveDocument.Bookmarks.Item(Marca).Range.Paste;
end;
SAludos
Salvador


La franja horaria es GMT +2. Ahora son las 15:49:31.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi