2010-12-07 21:18

     TYPE PSD
      lStructSize AS LONG
      hWndOwner AS LONG
      hDevMode AS LONG
      hDevNames AS LONG
      Flags AS LONG
      ptPaperSizeX AS LONG
      ptPaperSizeY AS LONG
      rtMinMarginLeft AS LONG
      rtMinMarginTop AS LONG
      rtMinMarginRight AS LONG
      rtMinMarginBottom AS LONG
      rtMarginLeft AS LONG
      rtMarginTop AS LONG
      rtMarginRight AS LONG
      rtMarginBottom AS LONG
      hInstance AS LONG
      lCustData AS LONG
      lpfnPageSetupHook AS LONG
      lpfnPagePaintHook AS LONG
      lpPageSetupTemplate AS LONG
      hPageSetupTemplate AS LONG
     END TYPE

     DECLARE FUNCTION PageSetupDlgAPI LIB "comdlg32" ALIAS "PageSetupDlgA" (lppsd AS PSD) AS LONG

     DIM prt AS PSD
     prt.lStructSize = SIZEOF(prt)
     prt.hWndOwner = Application.Handle
     prt.Flags = PSD_RETURNDEFAULT
     prt.hDevNames = 0
     prt.hDevMode = 0

     SUB PageSetupClick
      DIM f AS INTEGER

      f = IIF(prt.hDevMode = 0 OR prt.hDevNames = 0, 0, 1)
      IF f = 0 THEN f = PageSetupDlgAPI(prt)
      IF f <> 0 THEN
       prt.Flags = PSD_MARGINS OR PSD_DISABLEPRINTER
       PageSetupDlgAPI(prt)
      END IF
     END SUB

     SUB PagePrintClick
      DIM r AS STRING, s AS STRING, t AS STRING
      DIM x AS INTEGER, y AS INTEGER, xx AS INTEGER, yy AS INTEGER
      DIM i AS INTEGER, j AS INTEGER, n AS INTEGER, m AS INTEGER, o AS INTEGER
      DIM f AS INTEGER

      f = IIF(prt.hDevMode = 0 OR prt.hDevNames = 0, 0, 1)
      IF f = 0 THEN f = PageSetupDlgAPI(prt)
      IF f <> 0 THEN
       WITH Printer
        .Copies = 1
        .Font = IDE.MainFont
        .Orientation = IIF(prt.ptPaperSizeX  < prt.ptPaperSizeY, 0, 1)

        m = 0
        n = 1
        o = .TextHeight("Xy")

        x = .PageWidth * prt.rtMarginLeft / prt.ptPaperSizeX
        y = .PageHeight * prt.rtMarginTop / prt.ptPaperSizeY
        xx = .PageWidth - (Printer.PageWidth * prt.rtMarginRight / prt.ptPaperSizeX) - x      yy = .PageHeight - (Printer.PageHeight * prt.rtMarginBottom / prt.ptPaperSizeY) - y

        .BeginDoc
        FOR i = 1 TO re.LineCount
         s = re.Line(i - 1)
         t = ""

         FOR j = 1 TO LEN(s)
          r = MID$(s, j, 1)
          IF r = TAB THEN r = SPACE$(6 - (LEN(t) MOD 6))

          IF xx < .TextWidth(t + r) THEN
           IF yy < m + o THEN
            .NewPage
            n = n + 1
            m = 0
           END IF
           IF t <> "" THEN .TextOut(x, y + m, t, 0, -1)
           m = m + o
           t = r
          ELSE
           t = t + r
          END IF
         NEXT

         IF yy < m + o THEN
          .NewPage
          n = n + 1
          m = 0
         END IF
         IF t <> "" THEN .TextOut(x, y + m, t, 0, -1)
         m = m + o
         t = ""
        NEXT
        .EndDoc

'      MessageBox(Application.Handle, STR$(n) & " page(s) sent to " & .Printers(.PrinterIndex), Application.Title, MB_OK OR MB_ICONASTERISK)
       END WITH
      END IF
     END SUB

2010-12-07 21:18