Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   OOP (https://www.clubdelphi.com/foros/forumdisplay.php?f=5)
-   -   Insertar imagen desde campo blob en excel (https://www.clubdelphi.com/foros/showthread.php?t=64121)

David 18-03-2009 10:55:49

Insertar imagen desde campo blob en excel
 
Hola

Estoy con firebird, delphi6, tengo un campo blob donde almaceno las imagenes, y quiero guardarlas cada una en una celda de excel.

el código es el siguiente y funciona:

ExcelApplication1 es obviamente un TExcelApplication.

En el ClientDataSet hay un campo llamado IMAGEN, de tipo Blob

Código Delphi [-]
procedure TForm1.EjemploExcel;
var
WorkBk : _WorkBook;
 WorkSheet : _WorkSheet;
begin
  ExcelApplication1.Connect;
  ExcelApplication1.Workbooks.Add(xlWBatWorkSheet,0);

  WorkBk := ExcelApplication1.WorkBooks.Item[1];
  WorkSheet := WorkBk.WorkSheets.Get_Item(1) as _WorkSheet;
  WorkSheet.Name := 'documento';


  
  fila := 4;

  ClientDataSet1.First;
  while not ClientDataSet1.Eof do
  begin

    inc(fila);
    WorkSheet.Range['A'+IntToStr(fila),'A'+IntToStr(fila)].Value:= ClientDataSet1.FieldByName('FACTURA').AsString;
    WorkSheet.Range['B'+IntToStr(fila),'B'+IntToStr(fila)].Value:= ClientDataSet1.FieldByName('CONCEPTO').AsString;
    WorkSheet.Range['C'+IntToStr(fila),'C'+IntToStr(fila)].Value:= ClientDataSet1.FieldByName('Precio').AsFloat;
    WorkSheet.Range['D'+IntToStr(fila),'D'+IntToStr(fila)].Value:= ClientDataSet1.FieldByName('TIPO').AsString;

//He aquí la cuestión como almaceno en la celda E correspondiente, la image guardada en el campo IMAGEN, del ClientDataSet que es del tipo Blob
//WorkSheet.Range[E'+IntToStr(fila),'E'+IntToStr(fila)] (que es lo que sigue aquí??)
ClientDataSet1.Next;
end;

ExcelApplication1.Visible[0]:=true;
  ExcelApplication1.Disconnect;
end;

a ver si alguien sabe como hacer esto, estoy algo perdido, he visto algún ejemplo en el foro, pero son imagenes desde archivo y no se guardan en una celda sino en el libro.

David 18-03-2009 18:30:34

bueno he estado todo el día liado con esto, y he visto cosas a trozos, así que voy a poner un resumen en código de como se hace.

Código Delphi [-]
procedure TForm1.CrearDocumentoExcel;
var

 Stream : TMemoryStream;
 rutaImagen : String;

 WorkBk : _WorkBook;
 WorkSheet : _WorkSheet;

 BmpImg: TBitmap;
 picture: OleVariant;
 jpeg: TJpegImage;
 Rectangle: TRect;
begin

  rutaImagen := 'C:\miImagen.jpg';
  ExcelApplication1.Connect; // donde ExcelApplication1 es un componente TExcelApplication de la paleta Servers
  ExcelApplication1.Workbooks.Add(xlWBatWorkSheet,0);

  WorkBk := ExcelApplication1.WorkBooks.Item[1];
  WorkSheet := WorkBk.WorkSheets.Get_Item(1) as _WorkSheet;
  WorkSheet.Name := 'Libro1';

  WorkSheet.Range['D2','D2'].Value := 'Titulo Principal';
  WorkSheet.Range['D2','D2'].Font.Bold := true;
  WorkSheet.Range['D2','D2'].Font.Size := 14;
  WorkSheet.Range['D2','D2'].HorizontalAlignment := xlCenter;

  fila := 4;
  for i:=0 to 5 do // Caracteristicas de la cabecera de la columna, cada uno a su gusto
  begin
    ExcelApplication1.Range[char(65+i)+IntToStr(fila),char(65+i)+IntToStr(fila)].Font.Bold := true;
    ExcelApplication1.Range[char(65+i)+IntToStr(fila),char(65+i)+IntToStr(fila)].Interior.ColorIndex := 44;
    ExcelApplication1.Range[char(65+i)+IntToStr(fila),char(65+i)+IntToStr(fila)].HorizontalAlignment := xlCenter;
    ExcelApplication1.Range[char(65+i)+IntToStr(fila),char(65+i)+IntToStr(fila)].VerticalAlignment := xlCenter;
    ExcelApplication1.Range[char(65+i)+IntToStr(fila),char(65+i)+IntToStr(fila)].Borders.LineStyle := xlContinuous;
    ExcelApplication1.Range[char(65+i)+IntToStr(fila),char(65+i)+IntToStr(fila)].ColumnWidth := anchodelacolumna;//personalizar para una o varias columnas
    ExcelApplication1.Range[char(65+i)+IntToStr(fila),char(65+i)+IntToStr(fila)].RowHeight := 25;
    ExcelApplication1.Range[char(65+i)+IntToStr(fila),char(65+i)+IntToStr(fila)].WrapText := true;
  end;

 // Las cabeceras, con sus respectivos títulos
  WorkSheet.Range['A4','A4'].Value:= 'TituloColumn1';
  WorkSheet.Range['B4','B4'].Value:= 'TituloColumn2';
  WorkSheet.Range['C4','C4'].Value:= 'TituloColumn3';
  WorkSheet.Range['D4','D4'].Value:= 'TituloColumn4';
  WorkSheet.Range['E4','E4'].Value:= 'TituloColumn5';
  WorkSheet.Range['F4','F4'].Value:= 'TitulocolumnImagen';

  MiClientDataSet.First;//Recorremos el objeto DataSet
  while not MiClientDataSet.Eof do
  begin
    // Un campo, calculado o no, que nos diga si el registro tiene imagen
    if MiClientDataSet.FieldByName('EXISTE_IMAGEN').AsInteger = 1 then
      altura := 60
    else
      altura := 12;

    inc(fila);
    WorkSheet.Range['A'+IntToStr(fila),'A'+IntToStr(fila)].RowHeight := altura;
    WorkSheet.Range['A'+IntToStr(fila),'A'+IntToStr(fila)].NumberFormat := '@';//formato texto para la celda
    WorkSheet.Range['A'+IntToStr(fila),'A'+IntToStr(fila)].Value:= MiClientDataSet.FieldByName('CAMPO1').AsString;
    WorkSheet.Range['B'+IntToStr(fila),'B'+IntToStr(fila)].Value:= MiClientDataSet.FieldByName('CAMPO2').AsString;

    //Ahora establezco 3 celdas con formato de números
    WorkSheet.Range['C'+IntToStr(fila),'E'+IntToStr(fila)].HorizontalAlignment := xlRight;
    WorkSheet.Range['C'+IntToStr(fila),'E'+IntToStr(fila)].NumberFormat := '#.##0,00';

    WorkSheet.Range['C'+IntToStr(fila),'C'+IntToStr(fila)].Value:= MiClientDataSet.FieldByName('CAMPO3').AsFloat;
    WorkSheet.Range['D'+IntToStr(fila),'D'+IntToStr(fila)].Value:= MiClientDataSet.FieldByName('CAMPO4').AsString;
    WorkSheet.Range['E'+IntToStr(fila),'E'+IntToStr(fila)].Value:= MiClientDataSet.FieldByName('CAMPO5').AsFloat;

    if MiClientDataSet.FieldByName('EXISTE_IMAGEN').AsInteger = 1 then
    begin
      try
        jpeg := TJpegImage.Create;
        BmpImg := TBitmap.Create;


        stream := TMemoryStream.Create;
        stream := TMemoryStream.Create;
        TBlobField(MiClientDataSet.FieldByName('IMAGEN')).SaveToStream(stream);//El campo IMAGEN es BLOB, antes en el programa ya ha guardado la imagen
        stream.Position := 0;
        jpeg.LoadFromStream(stream);
        Rectangle := Rect(0, 0, 50, 50);//redimensionamos la imagen
        with BmpImg do
        begin
          Width := 50;
          Height := 50;
          Canvas.StretchDraw(Rectangle, jpeg);
        end;
      finally
        jpeg.Assign(BmpImg);
        jpeg.SaveTofilae(rutaImagen);//usamos una imagen comodin que esta guardada en el disco duro
        jpeg.Free;
      end;
      
      picture := ExcelApplication1.ActiveSheet;
      picture := oSheet.shapes.addpicture(rutaImagen, false, True, WorkSheet.Range['F'+IntToStr(fila),'F'+IntToStr(fila)].Left+15, WorkSheet.Range['F'+IntToStr(fila),'F'+IntToStr(fila)].Top+5, 50, 50);
      picture.Placement:= xlMoveAndSize; // Importante para fijar la imagen a la celda
    end;

    MiClientDataSet.Next;
  
  end;
  if filaeExists(rutaImagen) then // si la imagen comodin existe, la borramos
    Deletefilae(rutaImagen);
    

  ExcelApplication1.Visible[0]:=true;
  ExcelApplication1.Disconnect;
end;

Atención, no sale bien, si hay algún documento Excel abierto en el ordenador, en tal caso habría que cerrar el documento excel e intentarlo de nuevo.

Ya tengo una duda, alguien sabe como detectar si Excel está o no abierto, una función api o de delphi que lo averigue. Yo pongo el mensaje: "Cierren los documentos Excel antes de continuar", pero si tuviera una función que me dijera, tiene un documento excel abierto, cierrelo por favor, seria genial.:D


La franja horaria es GMT +2. Ahora son las 23:45:41.

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