XProfan

 $I Profalt.inc
'################################
'Drucken mit dem Richedit-Control
'################################
DEF StartDoc(2)      ! "gdi32","StartDocA"
DEF StartPage(1)     ! "gdi32","StartPage"
DEF EndPage(1)       ! "gdi32","EndPage"
DEF EndDoc(1)        ! "gdi32","EndDoc"
DEF CreateDC(4)      ! "gdi32","CreateDCA"
DEF DeleteDC(1)      ! "gdi32","DeleteDC"
DEF GetDeviceCaps(2) ! "gdi32","GetDeviceCaps"
DEF PrintDlg(1)      ! "comdlg32","PrintDlgA"
Declare Richedit&,RichDLL&,Ende&,Print&,Exit&,FileName$,Driver$,Printer$
Declare Horzres&,Vertres&,PixelsX&,PixelsY&,iWidthTwips&,iHeightTwips&
Declare iTextOut&,iTextLength&,DocName$
Declare PrinterDC&
Declare FormatRange#,PrintDLG#,cRect#
Declare DocInfo#
Dim FormatRange#,48
Dim DocInfo#,12
Clear DocInfo#
Dim PrintDLG#,66
Clear PrintDLG#
Dim cRect#,16
SetTrueColor 1
Window 0,0-640,480
CLS RGB(196,196,196)
Print& = CreateButton(%hwnd,"Drucken",500,40,80,24)
Exit& = CreateButton(%hwnd,"Ende",500,70,80,24)
RichEdit& = Create("RichEdit",%hwnd,"",0,2,460,430)
FileName$ = LoadFile$("Als RTF öffnen","*.RTF")

If FileName$ <> ""

    RTF("LoadRTF",Richedit&,Filename$)

EndIf

DocName$ = "Profan-RTFPrinter"

Whilenot Ende&

    Waitinput

    If GetFocus(Exit&)

        Ende& = 1

    ElseIf GetFocus(Print&)

        Long PrintDLG#,0  = 66
        Long PrintDLG#,4  = %hwnd
        Long PrintDLG#,20 = $0140'PD_RETURNDC,PD_PRINTSETUP
        PrintDlg(PrintDLG#)
        PrinterDC& = Long(PrintDLG#,16)

        If PrinterDC&

            HorzRes& = GetDeviceCaps(PrinterDC&,8)
            VertRes& = GetDeviceCaps(PrinterDC&,10)
            PixelsX& = GetDeviceCaps(PrinterDC&,88)
            PixelsY& = GetDeviceCaps(PrinterDC&,90)
            iWidthTwips& = Int((HorzRes&/PixelsX&))*1440
            iHeightTwips& = Int((VertRes&/PixelsY&))*1440
            Long cRect#,0 = 0
            Long cRect#,4 = 0
            Long cRect#,8 = iWidthTwips&
            Long cRect#,12 = iHeightTwips&
            Long DocInfo#,0 = 12
            Long DocInfo#,4 = ADDR(Docname$)
            Long FormatRange#,0 = PrinterDC&'HDC
            Long FormatRange#,4 = PrinterDC&'TargetHDC
            Long FormatRange#,8 = 0'linker Rand in Twips
            Long FormatRange#,12 = 0'oberer Rand in Twips
            Long FormatRange#,16 = iWidthTwips&'rechter Rand in Twips
            Long FormatRange#,20 = iHeightTwips&'unterer Rand in Twips
            Long FormatRange#,24 = 0'linker Rand in Twips
            Long FormatRange#,28 = 0'oberer Rand in Twips
            Long FormatRange#,32 = iWidthTwips&'rechter Rand in Twips
            Long FormatRange#,36 = iHeightTwips&'unterer Rand in Twips
            Long FormatRange#,40 = 0'CharRange-MIN
            Long FormatRange#,44 = -1'CharRange MAX ( -1 = alles )
            iTextOut& = 0
            iTextLength& = SendMessage(RichEdit&, 14, 0, 0)- SendMessage(RichEdit&,186,0,0)
            StartDoc(PrinterDC&,DocInfo#)

            Whilenot OR(iTextOut& >= iTextLength&,itextOut& = -1)

                StartPage(PrinterDC&)
                Long FormatRange#,44 = -1
                iTextOut& = SendMessage(RichEdit&, 1081, 1, FormatRange#)
                Long FormatRange#,40 = iTextOut&
                SendMessage(RichEdit&,1075,0,cRect#)
                EndPage(PrinterDC&)

            Wend

            EndDoc(PrinterDC&)
            SendMessage(RichEdit&, 1081, 1, 0)

        Endif

    Endif

EndWhile

Dispose FormatRange#
Dispose DocInfo#
Dispose PrintDLG#
DeleteDCon>PrinterDC&)
End

long fr#,0=hdcc,hdcc,cxPhysOffset,cyPhysOffset+HIER,iW...

print GetDeviceCaps(hdcc, PHYSICALOFFSETY)

var RANDLI%=0'in Twips
var RANDOB%=500'in Twips
var CXPHYSOFFSET%=GETDEVICECAPS(HDCC&, 112)+RANDLI%
var CYPHYSOFFSET%=GETDEVICECAPS(HDCC&, 113)+RAND