截取当前窗体放到Word打印

来源:互联网 发布:淘宝上的外卖是饿了么 编辑:程序博客网 时间:2024/05/17 21:48

 来源:http://topic.csdn.net/u/20100311/08/9c287fa6-a670-48f9-b149-9f4656a6cadb.html

uses

    ComObj, OleServer, WordXP

procedure TfrmVSScheduler.btnPrintClick(Sender: TObject);
var
  sFileName: string;
  Bmp: TBitmap;
  DC: HDC;
begin
  sFileName := ExtractFilePath(Application.ExeName) + 'FileData\Scheduler.bmp';
  self.BringToFront;
  DC := GetDC(GetDesktopWindow);
  Bmp := TBitmap.Create;
  try
    Bmp.Width := self.Width;
    Bmp.Height := self.Height;
    BitBlt(Bmp.Canvas.Handle, 0, 0,
      Bmp.Width, Bmp.Height, DC,
      self.Left, self.Top, SRCCOPY);
  finally
    ReleaseDC(GetDesktopWindow, DC);
  end;
  Bmp.SaveToFile(sFileName);
  Bmp.Free;
  printtoword(sFileName);
end;

procedure TfrmVSScheduler.Printtoword(sFileName: string);
var
  LinkToFile, SaveWithDocument: OleVariant;
  WordApplication1: OleVariant;
  WordDocument1: OleVariant;
begin
  try
    WordApplication1:=GetActiveOleObject('Word.Application');
  except
    try
      WordApplication1:=CreateOleObject('Word.Application');
    except
      MessageBox(handle,'无法链接,请检查是否安装Microsoft Word.','连接出错', MB_Ok or MB_ICONERROR);
      Abort;
    end;
  end;
  try
    WordApplication1.Visible := True;
    WordDocument1 := WordApplication1.Documents.Add(EmptyParam, false, EmptyParam, true);

    //横向
    WordDocument1.PageSetup.Orientation := wdOrientLandscape;
    //纵向
    //WordDocument1.PageSetup.Orientation := wdOrientPortrait;

    LinkToFile := False;
    SaveWithDocument := True;
    If FileExists(sFileName) Then
      WordApplication1.Selection.InlineShapes.AddPicture(sFileName, LinkToFile, SaveWithDocument, EmptyParam);
    WordApplication1.Activate;
    //预览
    //WordApplication1.PrintPreview := true;
  except on E: Exception do
    MessageBox(handle,'无法链接,请检查是否安装Microsoft Word.','连接出错', MB_Ok or MB_ICONERROR);
  end;
end;