English
Forum

RTF - Print

 

Thomas
Freier
wished one RTF multiple on several pages print. One of Pascal angepasstes Script goes.
CompileMarkSeparation
DEMO DRAWRICHTEXT GRÖSSENABFRAGE
window 0,0-400,300
 $H Windows.ph
 $H Messages.ph
 $H RichEdit.ph

proc DrawRichText2---------------------------------------------------------DrawRichText2

    parameters RTF&,PosX%,PosY%,MaxX%,MaxY%--Position + Grösse in Pixeln!
    declare PrinterDpiX%,PrinterDpiY%
    declare WindowDpiX%,WindowDpiY%
    declare fx!,fy!

    if %printing--Bei Druck: %HDC2 = %HDC = &PDC

        ~SetMapMode(%hdc2,1)
        ~SetWindowExtEx(%hdc2,1,1,0)
        ~SetViewPortExtEx(%hdc2,1,1,0)
        PosX%=PosX%+30--Korrektur ???
        PosY%=PosY%+30--Korrektur ???

    endif

    PrinterDpiX%=~GetDeviceCaps(%hdc2,~LOGPIXELSX)--dpi X des Druckers
    PrinterDpiY%=~GetDeviceCaps(%hdc2,~LOGPIXELSY)--dpi X des Druckers
    WindowDpiX%=~GetDeviceCaps(~GetDC(%hwnd),~LOGPIXELSX)--dpi X des Bildschirms (!)
    WindowDpiY%=~GetDeviceCaps(~GetDC(%hwnd),~LOGPIXELSY)--dpi Y des Bildschirms (!)
    PosX%=int(PosX%/WindowDpiX%*1440)
    PosY%=int(PosY%/WindowDpiX%*1440)
    MaxX%=int(MaxX%/WindowDpiX%*1440)
    MaxY%=int(MaxY%/WindowDpiX%*1440)
    declare Range#
    dim Range#,48
    clear Range#
    long Range#, 0=%hdc2,%hdc2
    long Range#, 8=PosX%,PosY%,PosX%+MaxX%,PosY%+MaxY%
    long Range#,24=PosX%,PosY%,PosX%+MaxX%,PosY%+MaxY%
    long Range#,44=-1
    sendmessage(RTF&,~EM_FORMATRANGE,1,Range#)

    if %printing

        fx!=~GetDeviceCaps(%hdc2,~LOGPIXELSX)/300
        fy!=~GetDeviceCaps(%hdc2,~LOGPIXELSY)/300
        ~SetMapMode(%hdc2,~MM_ANISOTROPIC)
        ~SetWindowExtEx(%hdc2,6400,9600,0)
        ~SetViewPortExtEx(%hdc2,int(2200*fx!),int(3300*fy!),0)

    endif

    dispose Range#
    casenot %printing:repaint
    endproc---------------------------------------------------------------------------------
    Print "Bitte warten, der Druck wird vorbereitet!"
    var hFont% = @Create("Font","Arial",20,12,0,0,0)
    declare RtfDll&,RichEdit&
    RtfDll&=usedll("RichEd20.dll")
    RichEdit&=control("RichEdit20A","Test",$500050c4,0,0,0,0,%hwnd,5000,0)
    settext RichEdit&,"Diese RTF-Anwendung läßt mich nicht verzweifeln!"
    SetFont RichEdit&,hFont%
    declare Breite%,Höhe%
    Breite%= 400
    Höhe%= 200
    var    y1%=0
    var    x1%=0
    startprint
    var y%=0

    While y% < 26  ....einfach einmal auf zwei Seiten drucken

        DrawRichText2 RichEdit&,(y1%*4.40),(x1%*4.40),400,200
        inc y%
        y1%=y1% + 105

        if y1%>105

            y1%=0
            x1%=x1%+43

            IF x1%>290

                x1%=0
                NEXTPAGE

            endif

        endif

    wend

    endprint
    destroywindow(RichEdit&/span>
    waitkey

In of my, here heavy gekürzten, application becomes the Font on the second Page changed what about me find whom Error not.
CompileMarkSeparation
LABEL-EDIT-DRUCK-E
 $H windows.ph
 $H Messages.ph
 $H RichEdit.ph

proc DrawRichText2---------------------------------------------------------DrawRichText2

    parameters RTF&,PosX%,PosY%,MaxX%,MaxY%--position + Size in Pixeln!
    declare PrinterDpiX%,PrinterDpiY%
    declare WindowDpiX%,WindowDpiY%
    declare fx!,fy!

    if %printing--with pressure: %HDC2 = %HDC = &PDC

        ~SetMapMode(%hdc2,1)
        ~SetWindowExtEx(%hdc2,1,1,0)
        ~SetViewPortExtEx(%hdc2,1,1,0)
        PosX%=PosX%+3--Korrektur ???
        PosY%=PosY%+3--Korrektur ???

    endif

    PrinterDpiX%=~GetDeviceCaps(%hdc2,~LOGPIXELSX)--dpi X the Druckers
    PrinterDpiY%=~GetDeviceCaps(%hdc2,~LOGPIXELSY)--dpi X the Druckers
    WindowDpiX%=~GetDeviceCaps(~GetDC(%hwnd),~LOGPIXELSX)--dpi X the Bildschirms (!)
    WindowDpiY%=~GetDeviceCaps(~GetDC(%hwnd),~LOGPIXELSY)--dpi Y the Bildschirms (!)
    PosX%=int(PosX%/WindowDpiX%*1440)
    PosY%=int(PosY%/WindowDpiX%*1440)
    MaxX%=int(MaxX%/WindowDpiX%*1440)
    MaxY%=int(MaxY%/WindowDpiX%*1440)
    declare brat#
    dim brat#,48
    clear brat#
    long brat#, 0=%hdc2,%hdc2
    long brat#, 8=PosX%,PosY%,PosX%+MaxX%,PosY%+MaxY%
    long brat#,24=PosX%,PosY%,PosX%+MaxX%,PosY%+MaxY%
    long brat#,44=-1
    sendmessage(RTF&,~EM_FORMATRANGE,1,brat#)

    if %printing

        fx!=~GetDeviceCaps(%hdc2,~LOGPIXELSX)/300
        fy!=~GetDeviceCaps(%hdc2,~LOGPIXELSY)/300
        ~SetMapMode(%hdc2,~MM_ANISOTROPIC)
        ~SetWindowExtEx(%hdc2,6400,9600,0)
        ~SetViewPortExtEx(%hdc2,int(2200*fx!),int(3300*fy!),0)

    endif

    dispose brat#
    casenot %printing:repaint
    endproc---------------------------------------------------------------------------------
    #########################################################################################

    Proc Label

        declare x1%,y1%
        Declare rtf#
        Declare x&,x%,y%
        declare Label_m&,RtfDll&,Label_dlg&
        declare a#
        declare LB_form&
        declare RichEdit&
        declare MaxB%,MaxH%
        declare IstB%,IstH%
        declare Pos#
        declare WndProc&
        dim Pos#,8
        dim rtf#,512
        RtfDll&=usedll("RichEd20.dll")
        WINDOWSTYLE 16
        Label_m&=create("Window",%hwnd,"Adresslabelformat: 105x43 ; on the leaf: 7 Lines + 2 Reihen",100,50, 640,640)
        usefont "MS Sans Serif",16,0,0,0,0
        setdialogfont 1
        var hFont% = @Create("Font","Arial",20,12,0,0,0)
        var  BP_but4& =@Create("Button",Label_m&,"Drucken",450,554,82,25)
        var  BP_but5& = @Create("Button",Label_m&,"Ende",540,554,82,25)
        .....................................................................RTF-Edit produce
        Label_dlg&=@Control("STATIC","",$5400110E,0,32,624,340,Label_m&,$7918,%hinstance)
        MaxB%=405
        MaxH%=243
        x%= (MaxB%/2) - 50
        Lb_form&=@Control("STATIC","",$5400110E,x%,5,MaxB%/2,20,Label_dlg&,$7918,%hinstance)
        RichEdit&=control("RichEdit20A","",$54005004,33,33,MaxB%,MaxH%,Label_dlg&,5000,0)
        settext RichEdit&,"Diese RTF-application can me verzweifeln!"
        SetFont RichEdit&,hFont%

        while 1

            WaitInput
            case GetFocus(BP_but5&): break

            If GetFocus(BP_but4&)  ----------------------------Print

                y1%=0
                x1%=0
                startprint
                y%=0

                While y% < 26  ....simply once on two pages print

                    DrawRichText2 RichEdit&,(y1%*4.40),(x1%*4.40),400,200
                    inc y%
                    y1%=y1% + 105

                    if y1%>105

                        y1%=0
                        x1%=x1%+43

                        IF x1%>290

                            x1%=0
                            NEXTPAGE

                        endif

                    endif

                wend

                endprint

            EndIf

        endwhile

        destroywindow(RichEdit&)
        dispose rtf#
        dispose a#
        dispose pos#
        destroywindow(Label_m&)
        freedll RtfDll&

    ENDPROC

    #########################################################################################
    WINDOWSTYLE 543512+8+2
    Windowtitle "CSV data for Adresslabel"
    window 0,0 - 900,600
    Label                       Adresslabel
    destroywindow(%hWnd)
    end

sees it of/ one of you or has a hint, Why it lying could?
 
Gruß Thomas
Windows XP SP2, XProfan X2
08/20/08  
 




Dieter
Zornow
i think time to each nextpage ought to or must the Font new transfer go.
Habs not tested, because all I to that print out have.
 
Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2
08/20/08  
 




Thomas
Freier
@ Dieter , I use at testing "FreePDF XP".
The eigentliche process:
first dbf Datensatz
The blanko.rtf becomes loaded
The Placeholder (dbf-Feldnamen) go once more screen
then The suitable RTF-row with the Data from the dbf supplant
expression on the vorgesehenen position.
The RTF deleted
next dbf Datensatz
The blanko.rtf becomes loaded
etc.
so should it really weg. unfortunately only on the 1. Page.
 
Gruß Thomas
Windows XP SP2, XProfan X2
08/20/08  
 




Jörg
Sellmeyer
Daieter has right with NextPage: [...]  [...] 
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
08/20/08  
 




Thomas
Freier
@ Jörg, that You the ausbuddeln would was me clear.
but, here extended with data, yields the desired with "nextpage".
CompileMarkSeparation
DEMO DRAWRICHTEXT GRÖSSENABFRAGE
 $H Windows.ph
 $H Messages.ph
 $H RichEdit.ph
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 $I Listview_Funktionen.inc
var lvdll&=usedll("Listview.dll")
Declare bereich#,bytes&,Label_view&,x&,y&,z&,x%
Declare listview&, text$
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Def GetSysColor(1) !"USER32","GetSysColor"
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

proc DrawRichText2---------------------------------------------------------DrawRichText2

    parameters RTF&,PosX%,PosY%,MaxX%,MaxY%--Position + Grösse in Pixeln!
    declare PrinterDpiX%,PrinterDpiY%
    declare WindowDpiX%,WindowDpiY%
    declare fx!,fy!

    if %printing--Bei Druck: %HDC2 = %HDC = &PDC

        ~SetMapMode(%hdc2,1)
        ~SetWindowExtEx(%hdc2,1,1,0)
        ~SetViewPortExtEx(%hdc2,1,1,0)
        PosX%=PosX%+30--Korrektur ???
        PosY%=PosY%+30--Korrektur ???

    endif

    PrinterDpiX%=~GetDeviceCaps(%hdc2,~LOGPIXELSX)--dpi X des Druckers
    PrinterDpiY%=~GetDeviceCaps(%hdc2,~LOGPIXELSY)--dpi X des Druckers
    WindowDpiX%=~GetDeviceCaps(~GetDC(%hwnd),~LOGPIXELSX)--dpi X des Bildschirms (!)
    WindowDpiY%=~GetDeviceCaps(~GetDC(%hwnd),~LOGPIXELSY)--dpi Y des Bildschirms (!)
    PosX%=int(PosX%/WindowDpiX%*1440)
    PosY%=int(PosY%/WindowDpiX%*1440)
    MaxX%=int(MaxX%/WindowDpiX%*1440)
    MaxY%=int(MaxY%/WindowDpiX%*1440)
    declare Range#
    dim Range#,48
    clear Range#
    long Range#, 0=%hdc2,%hdc2
    long Range#, 8=PosX%,PosY%,PosX%+MaxX%,PosY%+MaxY%
    long Range#,24=PosX%,PosY%,PosX%+MaxX%,PosY%+MaxY%
    long Range#,44=-1
    sendmessage(RTF&,~EM_FORMATRANGE,1,Range#)

    if %printing

        fx!=~GetDeviceCaps(%hdc2,~LOGPIXELSX)/300
        fy!=~GetDeviceCaps(%hdc2,~LOGPIXELSY)/300
        ~SetMapMode(%hdc2,~MM_ANISOTROPIC)
        ~SetWindowExtEx(%hdc2,6400,9600,0)
        ~SetViewPortExtEx(%hdc2,int(2200*fx!),int(3300*fy!),0)

    endif

    dispose Range#
    casenot %printing:repaint
    endproc---------------------------------------------------------------------------------

    Proc ErsetzeMultiLine

        Parameters REdit&,Line&
        Declare Index&,Index1&
        Index& = ~sendMessage(REdit&,~EM_LINEINDEX,Line&-1,0)
        Index1& = ~sendMessage(REdit&,~EM_LINEINDEX,Line&,0)
        ~sendmessage(REdit&,~EM_SETSEL,Index&,Index1&)
        ~sendmessage(REdit&,~EM_REPLACESEL,0,addr(c$)) Ersetzt den markierten Text
        Endproc----------------------------------------------------------------------------------
        WINDOWSTYLE 543512+8+2
        Windowtitle "CSV Daten für Adresslabel"
        window 0,0 - 900,600
        AppendMenuBar 3,"   Adresslabel   "
        x&=MixRGBs(GetSysColor(15),$00ffffff)
        listview&=CreateListView(%hwnd,%hinstance,0,x&,-1,$31)
        text$="Pliete.csv"
        bytes&=@FileSize(text$)

        If bytes&>0

            Dim bereich#,bytes&
            ReadFileQuick(addr(text$),bereich#,0,bytes&)
            x&=SetColumnsFromMem(listview&,bereich#,addr(y&))
            CsvToListview(listview&,(bereich#+y&),(bytes&-y&),x&)

        EndIf

        AutoSortListview listview&,1,1,1,1,2,2
        ShowListView(listview&,100,32,754,456)
        Print "Bitte warten, der Druck wird vorbereitet!"
        var hFont% = @Create("Font","Arial",20,12,0,0,0)
        declare RtfDll&,REdit&
        RtfDll&=usedll("RichEd20.dll")
        REdit&=control("RichEdit20A","Test",$500050c4,0,0,0,0,%hwnd,5000,0)
        RTF("LoadRTF",REdit&,"Aufkleber Brief.rtf")
        x%=3
        declare c$
        declare Breite%,Höhe%
        Breite%= 800
        Höhe%= 400
        var    y1%=0
        var    x1%=0
        startprint
        y&=0

        While y& < 226  ....einfach einmal auf zwei Seiten drucken

            c$="Herrn"+"
            "
            ErsetzeMultiLine(REdit&,4)Zeile ersetzen
            GetItemText(listview&,bereich#,1,y&)
            c$=String$(bereich#,0)
            GetItemText(listview&,bereich#,2,y&)
            c$=c$ + " " + String$(bereich#,0) + "
            "
            ErsetzeMultiLine(REdit&,5)Zeile ersetzen
            GetItemText(listview&,bereich#,11,y&)
            c$=String$(bereich#,0) + "
            "
            ErsetzeMultiLine(REdit&,6)Zeile ersetzen
            GetItemText(listview&,bereich#,9,y&)
            c$=String$(bereich#,0)
            GetItemText(listview&,bereich#,10,y&)
            c$=c$ + " " + String$(bereich#,0) + "
            "
            ErsetzeMultiLine(REdit&,8)Zeile ersetzen
            DrawRichText2 REdit&,(y1%*4.40),(x1%*4.40),400,200
            inc y&
            y1%=y1% + 105

            if y1%>105

                y1%=0
                x1%=x1%+43

                IF x1%>290

                    x1%=0
                    NEXTPAGE

                endif

            endif

        wend

        endprint
        WaitInput
        destroywindow(REdit&)
        dispose bereich#
        destroywindow(%hWnd)
        /../../funcion-referencias/XProfan/freedll/'>freedll lvdll&
         $I Listview_Dispose.inc

have but yet a code found:
CompileMarkSeparation
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&)

whom I try will be.
 
Gruß Thomas
Windows XP SP2, XProfan X2
08/21/08  
 




Thomas
Freier
@Jörg, I hope my comment wasn't To hard. but UseFont must really on the Font in the RTF too at Print or erzwungenem Seitenwechsel none influence take. though, with XProfan is not gewiss. an A5 RTF becomes at Save to a A4 RTF. Why??? Genaues becomes well only Roland know.
do not have of/ one a hint, like a Seitenwechsel erzwungen becomes, except Druckersteuerzeichen To Send?
 
Gruß Thomas
Windows XP SP2, XProfan X2
08/22/08  
 



Answer


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

1.447 Views

Untitledvor 0 min.
Uwe Lang06/20/23
Member 361000512/01/22
H.Brill02/08/22
RudiB.11/06/21
More...

Themeninformationen



Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.


all rightDatenschutzerklärung
i want none Cookie