截取当前窗体放到Word打印

最新推荐文章于 2024-09-24 17:39:05 发布

chelen_jak

最新推荐文章于 2024-09-24 17:39:05 发布

阅读量684

点赞数

分类专栏： Delphi 文章标签： microsoft exception string 2010 c

Delphi 专栏收录该内容

59 篇文章 0 订阅

订阅专栏

来源：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;