Forum | | | | Thomas Freier | wished one RTF multiple on several pages print. One of Pascal angepasstes Script goes. CompileMarkSeparationDEMO 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. CompileMarkSeparationLABEL-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 | | | | 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". CompileMarkSeparationDEMO 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: CompileMarkSeparationStartDoc(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 ▲ |
| |
|
AnswerThemeninformationenthis Topic has 3 subscriber: |