远古一装备怎么样:VFP利用WORD打印票据的一个通用程序

以前我做过一个支票打印程序，就是把存在数据库中的记录按照支票的格式进行套打。由于在VFP中设置自定义纸张比较麻烦，且报表中各项数据的位置也不太容易更改，所以我的程序中就把数据输出到Word中，然后进行打印。除了保存支票的表外，还需要两个表：一个页面设置表，一个各项数据的布局表。现在我把支票打印程序中的部分代码抽出来做来了通用的程序。

    Record2Word.prg


NOTE ;
    约定：1. 当前有三个表打开，这三个表分别存储要输出的各项记录、页面设置及各个字段的位置 ;
          2. 这三个表都有一个字段ID，整型，进行输出操作时根据ID来取数据 ;
          3. 三个表的结构：;
             表1 ID I, ID2 I... (其各他字段自行定义) ;
                 ID2用以标示与区别相同ID的不同记录 ;
             表2 ID I, Width B, Height B, Margin1 B, Margin2 B, Margin3 B, Margin4 B ;
                 其中：Width -页面宽度, Height -页面高度, Margin1 -上边距, Margin2 -下边距, ;
                 Margin3 -左边距, Margin4 -右边距 ;
             表3 ID I, Number I, value C(50), Name C(30), Size B, Bold L, Italic L, ;
                 Left B, Top B, Width B, Height B, Alignment I ;
                 其中各字段类型相符即可，长度不做硬性要求；value可以存府VFP表达式，如： ;
                 PADL(ALLTRIM(STR(YEAR(日期))),4,’ ’)， 其中“日期”是字段名。 ;
                 Name, Size, Bold, Italic, Left, Top, Width, Height, Alignment分别是 ;
                 文本框的字体名称、大小、加粗、倾斜、左、上、宽、高、对齐 ;
END


LPARAMETERS tnID, tnID2, tcAlias1, tcAlias2, tcAlias3, tlVisible, tlFlag
*-- tnID 三表中的相同字段ID的值
*-- tnID2 表1中的ID2字段值，为-1时打印所有表1中ID为tnID的记录
*-- tcAlias1, tcAlias2, tcAlias3 分别为表1、表2、表3的别名
*-- tlVisible 输出到Word中的整个过程是否可见
*-- tlFlag .F.-预览  .T.-打印

PRIVATE lcError, lcAlias, lnRecordNo, lnRecordNo1, lnRecordNo2, lnRecordNo3, lcTempAlias, ;
lnRecordCount, lnRecordCount2, laPageSetup[7], laLayout[1, 12], loWord, loActiveDocument, i, j

lcError = ""
lcAlias = ALIAS()
lnRecordNo = RECNO()

SELECT (tcAlias1)
lnRecordNo1 = RECNO()
lcTempAlias = SYS(2015)
IF tnID2 = -1
 SELECT * FROM (tcAlias1) WHERE ID = tnID INTO CURSOR (lcTempAlias)
ELSE
 SELECT * FROM (tcAlias1) WHERE ID = tnID AND ID2 = tnID2 INTO CURSOR (lcTempAlias)
ENDIF
lnRecordCount = _TALLY
lcError = IIF(_TALLY > 0, "", "ERROR")
= GoToRecordNo(tcAlias1, lnRecordNo1)
SELECT (tcAlias2)
lnRecordNo2 = RECNO()
SELECT * FROM (tcAlias2) WHERE ID = tnID INTO ARRAY laPageSetup
lcError = IIF(_TALLY > 0, "", "ERROR")
= GoToRecordNo(tcAlias2, lnRecordNo2)
SELECT (tcAlias3)
lnRecordNo3 = RECNO()
SELECT * FROM (tcAlias3) WHERE ID = tnID INTO ARRAY laLayout
lnRecordCount2 = _TALLY
lcError = IIF(_TALLY > 0, "", "ERROR")
= GoToRecordNo(tcAlias3, lnRecordNo3)
IF EMPTY(lcError) = .F.
 RETURN lcError
ENDIF

TRY
 loWord = CREATEOBJECT("Word.Application")
CATCH
 lcError = "ERROR"
ENDTRY
IF EMPTY(lcError) = .F.
 RETURN lcError
ENDIF

TRY
 loWord.Visible = tlVisible
 loActiveDocument = loWord.Documents.Add()
 loActiveDocument.Activate()
 loWord.ActiveWindow.View.Type = 3
 WITH loWord.ActiveDocument.PageSetup
  .LineNumbering.Active = .F.
  .Orientation = 1
  .TopMargin = laPageSetup[4]*28.35
  .BottomMargin = laPageSetup[5]*28.35
  .LeftMargin = laPageSetup[6]*28.35
  .RightMargin = laPageSetup[7]*28.35
  .Gutter = 0
  .HeaderDistance = 0
  .FooterDistance = 0
  .PageWidth = laPageSetup[2]*28.35
  .PageHeight = laPageSetup[3]*28.35
  .OddAndEvenPagesHeaderFooter = .F.
  .DifferentFirstPageHeaderFooter = .F.
  .SuppressEndnotes = .F.
  .MirrorMargins = .F.
  .TwoPagesOnOne = .F.
 ENDWITH
 SELECT (lcTempAlias)
 FOR i = 1 TO lnRecordCount
  GO i
  loWord.ActiveDocument.Paragraphs.Last.Range.Select
  loword.Selection.TypeText(" ")
  FOR j = 1 TO lnRecordCount2
   loWord.ActiveDocument.Shapes.AddTextbox(1, laLayout[j, 8]*28.35, laLayout[j, 9]*28.35, ;
   laLayout[j, 10]*28.35, laLayout[j, 11]*28.35).Select
   WITH loWord.Selection
    .Font.Name = laLayout[j, 4]
    .Font.Size = laLayout[j, 5]  
    .Font.Bold = laLayout[j, 6]
    .Font.Italic = laLayout[j, 7]
    .TypeText(EVALUATE(laLayout[j, 3]))
    .ShapeRange.Fill.Visible = 0
    .ShapeRange.Line.Transparency = 0
    .ShapeRange.Line.Visible = 0
    .ShapeRange.TextFrame.MarginLeft = 0
    .ShapeRange.TextFrame.MarginRight = 0
    .ShapeRange.TextFrame.MarginTop = 0
    .ShapeRange.TextFrame.MarginBottom = 0
    .ShapeRange.TextFrame.WordWrap = .T.
    .ParagraphFormat.Alignment = laLayout[j, 12]  
   ENDWITH
  ENDFOR
  IF i < lnRecordCount
   loWord.ActiveDocument.Paragraphs.Last.Range.Select()
   loWord.Selection.MoveRight()
   loWord.Selection.InsertBreak(2)
  ENDIF
 ENDFOR
CATCH
 lcError = "ERROR"
ENDTRY

IF EMPTY(lcError) = .F.
 RETURN lcError
ENDIF

IF EMPTY(lcAlias) = .F.
 SELECT (lcAlias)
 = GoToRecordNo(lcAlias, lnRecordNo)
ENDIF

IF tlFlag = .F.
 loWord.ActiveDocument.PrintPreview()
 loWord.Visible = .T.
ELSE
 loWord.ActiveDocument.PrintOut()
 loWord.Visible = .T.
ENDIF
        
            
            
PROCEDURE GoToRecordNo
 LPARAMETERS tcAlias, tnRecordNo
 SELECT (tcAlias)
 IF tnRecordNo > 1
  TRY
   GO (tnRecordNo)
  CATCH
  ENDTRY
 ENDIF
ENDPROC