insert a jpeg into excel cell.txt

Delphi编程练习：从数据库中读取JPEG图片

procedure Tfrm_BOM_Adm.btn_Export_BOMClick(Sender: TObject);
var
  ExcelApp: Variant;
  mRange:Variant;
  mInt_Excel_Lines:integer;//物料行号
//  mStr_Client_Model_Code:String;//产品物料编码
  mItem_Index:integer;

  pics:TStream;
  Jpeg:TJpegImage;
  aSheet:Variant;
  FPicture:OleVariant;
  W0,H0,W1,H1:integer;
begin
//uses jpeg, ComObj;

  if (not ibqry_Client_Model_Code.Active) then
  begin
    showmessage('当前无数据!');
    exit;
  end;

  //打开Excel文档模板
  ExcelApp:=CreateOleObject('Excel.Application');
  ExcelApp.WorkBooks.Open(ExtractFilePath(Application.ExeName)+'Documents\33 BOM物料清单.xls');
  ExcelApp.WorkSheets[1].Activate;
  ExcelApp.Visible:=true;//

  mInt_Excel_Lines:=4;//Excel表从第4行开始输出数据

  with ibqry_Client_Model_Code do
  begin
    //mStr_Client_Model_Code:=fieldbyname('CLIENT_MODEL_CODE').AsString;//产品物料编码
    ExcelApp.Cells[2,1].Value:='客户：'+fieldbyname('NAME_FOR_SHORT').AsString+'  出口地：'+fieldbyname('EXPORT_PLACE').AsString
                              +'  客户型号：'+fieldbyname('CLIENT_MODEL').AsString+'  工厂型号：'+fieldbyname('FACTORY_MODEL').AsString
                              +'  颜色：'+fieldbyname('COLOR_NAME').AsString;

    //在单元格中插入图片
    if TBlobField(FieldByName('PIC_BLOB')).value='' then
    begin
      //Image1.Picture:=nil;
    end
    else
    begin
      pics:=TMemoryStream.Create;
      TBlobField(FieldByName('PIC_BLOB')).SaveToStream(pics);//将二进制存入内存流
      pics.Position:=0;
      Jpeg:=TJpegImage.Create;
      Jpeg.LoadFromStream(pics);//将流识别为JPEG格式

      //保存图片到文件
      jpeg.SaveToFile(ExtractFilePath(Application.ExeName)+'Pic.JPEG');

      //往单元格中插入图片
      //合并单元格(灯图区)
      mRange:=ExcelApp.Range[ExcelApp.cells[mInt_Excel_Lines,1],ExcelApp.cells[mInt_Excel_Lines+15,1]];
      mRange.merge;

      aSheet:=ExcelApp.WorkSheets[1];
      aSheet.Range[ExcelApp.cells[mInt_Excel_Lines,1],ExcelApp.cells[mInt_Excel_Lines,1]].Select;//这里是定位图片插入的位置(f没有意义)
      FPicture:=aSheet.Pictures.Insert(ExtractFilePath(Application.ExeName)+'Pic.JPEG');
      //ExcelApp.Cells[mInt_Excel_Lines+16,1].Value:='图片名称： '+FieldByName('PIC_NAME').AsString;

      //锁定纵横比例
      W0:=FPicture.width;
      H0:=FPicture.height;
      W1:=180;
      H1:=(W1*H0) div W0;
      if H1>250 then
      begin
        H1:=250;
        W1:=(H1*W0) div H0;
      end;
      FPicture.height:=H1;
      FPicture.width:=W1;

      //位置移到左右居中
      FPicture.Left:=FPicture.Left+2+(180-W1)/2;//此处的坐标指的是整个界面坐标
      FPicture.Top:=FPicture.Top+2+(250-H1)/2;
        
      FPicture:=null;
      pics.Free;
      jpeg.Free;
    end;

    with ibqry_BOM do
    begin
      if not active then open;
      first;
      mItem_Index:=0;
      while not eof do
      begin
        INC(mItem_Index);
        ExcelApp.Cells[mInt_Excel_Lines,2].Value:=mItem_Index;//序号
        ExcelApp.Cells[mInt_Excel_Lines,3].Value:=fieldByName('MATERIAL_DESCRIPTION').value;//品名规格
        ExcelApp.Cells[mInt_Excel_Lines,4].Value:=fieldByName('COLOR_NAME').value;//颜色
        ExcelApp.Cells[mInt_Excel_Lines,5].Value:=fieldByName('UNIT_QTY').value;//用量

        next;
        INC(mInt_Excel_Lines);//下一行
      end;
    end;

    //确保每个BOM有30行，以保证灯图有足够的空间
    while (mItem_Index<30) do
    begin
      INC(mItem_Index);
      ExcelApp.Cells[mInt_Excel_Lines,2].Value:=mItem_Index;//序号
      INC(mInt_Excel_Lines);//下一行
    end;
  end;

  ExcelApp.ActiveSheet.PrintPreview;
  showmessage('完成“导出数据”!');
  
end;