XProfan

English

Thomas
Freier

found I had of Andreas:
Compile Mark Separation

 $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

unfortunately end the pressure to 3 pages. WordPad druckt everything. How geht's with XProfan?

rtf-druck.zip	2.867 kB

Hochgeladen:	10/06/10

Downloadcounter:
		Download

Gruß Thomas
Windows XP SP2, XProfan X2

10/06/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

« this Posting watts as Solution marked. »

- Page 3 -

Uwe
''Pascal''
Niemeier

Hi Thomas!

apparently becomes from the FORMATRANGE-structure not only the To bedruckende area read, separate to the Print too the objectively genutzte area hinterlegt (or something like in the manner). therefore must the betroffene cut offed the structure each Schleifendurchlauf new equips go.

SeeYou
Pascal

druckdemo2.prf	6 kB

Version:	2

Kurzbeschreibung:	RTF print

Hochgeladen:	10/26/10

Downloadcounter:
		Download

10/26/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

- Page 3 -

- Page 2 -

Thomas
Freier

i'd it rather find, if your Scrips, The Yes very well are, too famous gewordene Error not any more hätten.
is still too possible, that Uwes example under designed Umständen in a Endlosschleife end. to safety has it now The max. To druckenden pages pretended. there's at employment naturally the trouble, that the Seitenanzahl the Dokumentes seldom detect can.

Gruß Thomas
Windows XP SP2, XProfan X2

10/21/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Uwe
''Pascal''
Niemeier

Hi people!

If one any functions, The whom printer directly address (StartDoc/EndDoc, StartPage/EndPage) auskommentiert, can The FormatRange-routine too "im Leerlauf" operate and so beforehand detect, wieviele pages printed would .

with something skill can so even to the Print on the Top and / or Seitenende additional Texts install, z.B. "Ende Page 1" "Anfang Page2" "Seite 1 of 3" etc.

Übrigens shining it with of my last demonstration in the Thread next door to with Dokumenten with pictures Abweichungen with whom tuned Rändern To geben; there erfolgen partly Seitenumbrüche, where no necessary wären. time see, whether there yet what make can.

@ Thomas: hope in Kürze a Solution to that Bearbeitern of RTF in RTF found to have.

SeeYou
Pascal

10/21/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Thomas suitor

i'd it rather...

No question, once I again on this PC ...

10/22/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Thomas
Freier

hey Pascal,
konntest You on this place another improvement find?

Übrigens shining it with of my last demonstration in the Thread next door to with Dokumenten with pictures Abweichungen with whom tuned Rändern To geben; there erfolgen partly Seitenumbrüche, where no necessary wären. time see, whether there yet what make can.

I have hither and thither probiert and the following fixes:
If I The, z.B. Hemmelsdorf, erstellte RTF some large Images (P1010404.JPG= 640x480) as big anhänge, so is the 1. Page OK. on the subesquent is each only one Image per Page.
If I The Images on the new erstellten Page lösche except for whom Text and sechsmal the image (P1010404.JPG) as big einfüge, go per Page 2 Images printed.

Gruß Thomas
Windows XP SP2, XProfan X2

10/24/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Uwe
''Pascal''
Niemeier

druckdemo2.prf	6 kB

Version:	2

Kurzbeschreibung:	RTF print

Hochgeladen:	10/26/10

Downloadcounter:
		Download

10/26/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Thomas
Freier

hey Pascal,

the sees super from. thanks!

with something skill can so even to the Print on the Top and / or Seitenende additional Texts install, z.B. "Ende Page 1" "Anfang Page2" "Seite 1 of 3" etc.

have you got there another crazy idea?
yet have I :
Compile Mark Separation

startpaint DC&
DrawText 2250,6725,"Seite "+str$(x%)'..........bei A4 hoch
endpaint
inc x%
~StartPage(DC&)'------------Seite beginnen > Vorbereitung Drucken/pre>

inserted. power at Font yet Problems. time becomes the Font the 1. row on two pages uses and then follows another. One other time becomes it on all pages uses.

Gruß Thomas
Windows XP SP2, XProfan X2

10/26/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Uwe
''Pascal''
Niemeier

Hi Thomas!

prerequisite for of me used engineering is, that document and gedruckte Page same many Lines include, because the suitable routine to the Print directly in that RTF-Edit writes. it must means no unkontrollierten Zeilenumbrüche on the edge of document and/or Page give.
Also gibt's yet Problems because of the Images.

SeeYou
Pascal

10/29/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Thomas
Freier

hey Pascal,
where are you on Problems with Images punched? I have so on The twenty Examples, large/small Images and Textzeilen insert/delete, tested and the pressure was always OK.
for the Seitenzahl set I downstairs Blattrand with 12mm and drucke The Seitenzahl in this edge without check on bedruckbaren area and Blattausrichtung becomes zwangsweise on A4-high staid.

Gruß Thomas
Windows XP SP2, XProfan X2

10/30/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Uwe
''Pascal''
Niemeier

Hi Thomas!

As I said, my method is, to the actual Print head- and/or Fußzeilen directly in that RTF-Edit To write.
has for my tack yet well functions, has but even too detriments or. isn't for each drop applicable. time see, whether the yet Change can.
will be me your engineering but too again look at.

BTW: These RTF-Version [...]

can also in Word erstellte tables with several Lines present.

SeeYou
Pascal

10/30/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Thomas
Freier

hey Pascal,
Dou you mean : whom type RichEdit50W (RichEdit 4.1) ?
from of/ one middle-aged application (here minimizes) have I yet:
Compile Mark Separation

' ab XProfan 8.0
Def SetEditNumeric(1) SetWindowLong(@&(1),-16, (GetWindowLong(@&(1),-16) | $2002))
Def SetWindowLong(3) !"USER32", "SetWindowLongA"
Def GetWindowLong(2) !"USER32", "GetWindowLongA"
Def GetSysColor(1) !"USER32","GetSysColor"
Declare text$,text1$,x%,h$
Declare ed1&,ed2&
Declare sed1&,sed2&,sed3&,sed4&,sed5&
Declare hed1&
Declare but&,sich&
Declare font&
SetTrueColor 1
Window 10,10 - 900,600
cls GetSysColor(15)
font&=CreateFont("Arial",16,0,0,0,0)
SetDialogFont  font&
ed1&=Create("RichEdit",%hwnd,"",11,10,700,500)
ed2&=Create("RichEdit",%hwnd,"",0,00,0,0)
CreateText(%hwnd,"Spaltenbreite",760,80,100,22)
sed1&=CreateEdit(%hwnd,"200",760,110,100,22)
sed2&=CreateEdit(%hwnd,"200",760,140,100,22)
sed3&=CreateEdit(%hwnd,"200",760,170,100,22)
sed4&=CreateEdit(%hwnd,"",760,200,100,22)
sed5&=CreateEdit(%hwnd,"",760,230,100,22)
SetEditNumeric(sed1&)
SetEditNumeric(sed2&)
SetEditNumeric(sed3&)
SetEditNumeric(sed4&)
SetEditNumeric(sed5&)
CreateText(%hwnd,"Zeilenhöhe",760,300,100,22)
hed1&=CreateEdit(%hwnd,"12",760,330,100,22)
SetEditNumeric(hed1&)
but&=CreateButton(%hwnd,"Einfügen",760,360,100,24)
sich&=CreateButton(%hwnd,"Speichern",760,460,100,24)
SetFocus(ed1&)
settext Ed1&,"Bitte eine Tabellenzeile einfügen\nund für weitere Zeilen"+ \
" den Curser ans Zeilenende setzen und die Taste ENTER drücken.\n"+ \
"Die Spaltenbreite ist nachträglich nicht mehr zu verändern."+Chr$(13)+Chr$(10)
SendMessage(Ed1&,$00B1,-1,-1)

While 1

    WaitInput
    case %key=2:BREAK
    case GetFocus(But&) AND (val(GetText$(sed1&))>0) : RTF_Zeile

    If GetFocus(sich&)

        Text$ = @SaveFile$("Speichern","Neu.rtf")
        case Len(trim$(Text$))>0 : call(&SaveRTF,Ed1&,addr(Text$))

    EndIf

wend

DeleteObject font&
End

Proc RTF_Zeile

    Assign #1,"Zeile.tmp"
    Rewrite #1
    Print #1,"{\"+chr$(114)+"tf1\"+chr$(097)+"nsi\"+chr$(097)+"nsicpg1252\deff0\deflang1049\deflangfe1049{\"+chr$(102)+"onttbl{\"+chr$(102)+"0\"+chr$(102)+"nil\"+chr$(102)+"charset0 Arial;}}"
    Print #1,"\viewkind4\uc1"
    text$="\"+chr$(116)+"rowd\"+chr$(116)+"rgaph30"
    x%= int(val(GetText$(sed1&))*10)
    text$=text$+"\cellx"+str$(x%)
    text1$="\cell"
    h$= str$(int(val(GetText$(hed1&))*2))

    If val(GetText$(sed2&))>0

        x%= x%+int(val(GetText$(sed2&))*10)
        text$=text$+"\cellx"+str$(x%)
        text1$=text1$+"\cell"

    EndIf

    If val(GetText$(sed3&))>0

        x%= x%+int(val(GetText$(sed3&))*10)
        text$=text$+"\cellx"+str$(x%)
        text1$=text1$+"\cell"

    EndIf

    If val(GetText$(sed4&))>0

        x%= x%+int(val(GetText$(sed4&))*10)
        text$=text$+"\cellx"+str$(x%)
        text1$=text1$+"\cell"

    EndIf

    If val(GetText$(sed5&))>0

        x%= x%+int(val(GetText$(sed5&))*10)
        text$=text$+"\cellx"+str$(x%)
        text1$=text1$+"\cell"

    EndIf

    Print #1,text$+"\pard\intbl\lang1031\"+chr$(102)+"s"+h$+text1$+"\"+chr$(114)+"ow"
    Print #1,"\par}"
    Close #1
    Rtf("LoadRTF",ed2&,"Zeile.tmp")
    SetFocus(ed2&)
    sendmessage(ed2&,$00B1,0,-1)
    Sendmessage(ed2&,$301,0,0)
    Sendmessage(ed1&,$302,0,0)
    SetFocus

n>ed1&) ENDPROC

but unfortunately can itself the Raster not format, d.h. wenigens deutlicher present.

Gruß Thomas
Windows XP SP2, XProfan X2

10/31/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Uwe
''Pascal''
Niemeier

Hi Thomas!

to Einblendung of head/Fußzeilen:
apparently comes with the FormatRange-Message a function to that employment, The like DrawText works. therefore can with your eingeblendeten row the Font change. inverse can whom Font not pretending, because itself the the whole document auswirkt.
Solution: whom Text in the Profan-Memory bitmap lay out and then into pages overlay:
Compile Mark Separation

...
~StartDoc(DC&,DocInfo#)'-------Druckauftrag beginnen

whileloop 1,Seiten%'-----------Anzahl ermittelte Seiten

    mcls 500,100,255'--Farbe nur zu Testzwecken
    startpaint -1'-----%HDC nach StartPaint -1: DC der Speicherbitmap
    usefont "Balloon",50,0,0,0,0
    drawtext 0,0,"Seite "+str$(&loop)+" von "+str$(Seiten%)
    ~BitBlt(DC&,10,10,500,100,%hdc,0,0,~SRCCOPY)'--Parameter 2+3: Position in der Seite
    endpaint
    ~StartPage(DC&)'------------Seite beginnen > Vorbereitung Drucken   ...

Schriftgröße and position must on whom jeweiligen printer angepaßt werden; especially, if it a Footer go should. Can sure over Seitegröße/dissolution to charge.
but this ploy is In any drop circa Lengths rather as my Technik; thanks for Tipp!

To tables:
objectively behave itself your code with a 50W-Control differently.
but this behaviour is now time undokumentiert and therefore ought to one not absolutely on it leave. Tipp: if You The scheduler with Word erstellst and weiße lines dial, is tappt im dunkeln in the 50W not as scheduler To discern.

SeeYou
Pascal

11/02/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Thomas
Freier

your Script for Footer I will yet testing.
What the scheduler angeht, so I had tappt im dunkeln, slip with Platzhaltern, 2005 for lists (confirmation of order, bill, etc.) uses and only over XProfan printed. The lists saw with the slight gray Tabellenraster still rather from as without and the Page could as RTF stored go.

Gruß Thomas
Windows XP SP2, XProfan X2

11/02/10 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

◄

1 23