XProfan

 {$cleq}
 {$pushkeyword R_*}
 $U RTFHandling.pcu=R_'RTF-PCU einbinden
 $U objects.pcu=R_
window 0,0-%maxx,%maxy
var rtf_dll&= R_INTITFORCREATERTF()'DLL laden mit PCU
var RichEdit&=R_CREATERICHEDIT(%hwnd,"",10000,0,0,0,0)' Richedit erstellen mit PCU
var rtf_hdc&=R_PREPAREFORLINEBREAK(RichEdit&)' Device Context erzeugen mit PCU
R_Init_object(RichEdit&)'Zum Bildempfang vorbereiten
RTF("LoadRTF",RichEdit&,"Bilder-Album.rtf")
startprint "*xx"
RTFPrn(RichEdit&)
endprint
R_DEINITRTF(RichEdit&,rtf_hdc&,rtf_dll&)'RTF-Aufräumen
R_DeInit_object()'RTF-Aufräumen
End

proc RTFPrn

    Parameters wnd1&
    SetMapMode(&pdc,1)
    var iWidthTwips&=Int((GetDeviceCaps(&pdc,8)/GetDeviceCaps(&pdc,88)))*1440
    var iHeightTwips&=Int((GetDeviceCaps(&pdc,10)/GetDeviceCaps(&pdc,90)))*1440
    declare fr#
    dim fr#,48
    long fr#,0=&pdc,&pdc,GetDeviceCaps(&pdc,PHYSICALOFFSETX),GetDeviceCaps(&pdc,PHYSICALOFFSETY),iWidthTwips&,iHeightTwips&
    SendMessage(wnd1&,EM_SETSEL,0,-1)
    SendMessage(wnd1&,EM_EXGETSEL,0,addr(fr#)+40)
    var cpMin&=0

    while 1

        cpMin&=SendMessage(wnd1&,EM_FORMATRANGE,1,addr(fr#))
        case cpMin&>=long(fr#,44) :break
        long fr#,40=cpMin&
        nextPage
        SetMapMode(&pdc,1)

    wend

    dispose fr#
    SendMessage(wnd1&,EM_FORMATRANGE,0,0)

endproc