Source / code snippets | | | | | | - Page 1 - |
| 
Thomas
Freier | ex mode 2 (ex XP SP1) can in the RichEdit tables, its Text center or rechtsbündig reported is, inserted go. I use it to formation without Gitterlinien. One Item can, stay with the concept from the GridBOX, a mehrzeiligen Text, Images or further tables include. an Align is in each Item possible.
A small example (statement)
CompileMarkSeparation $H Windows.ph
$H Messages.ph
$H RichEdit.ph
DEF Redraw(1) ~RedrawWindow(&(1),0,0,~RDW_FRAME | ~RDW_INVALIDATE | ~RDW_ALLCHILDREN | ~RDW_ERASE)
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&,sed1%,sed2%,sed3%
Declare grid1&
Declare but&,but_L&,sich&,lade&,druck&
Declare font&, hfont&, hfont%
Declare row&
Declare links%, mitte%, rechts%
Declare rtf#
dim rtf#,60
SetTrueColor 1
Window 10,10 - 900,600
cls GetSysColor(15)
font&=CreateFont("Arial",16,0,0,0,0)
SetDialogFont font&
Create("Text",%hwnd,"Textausrichtung",36,1,100,22)
links% = @Create("Button", %hwnd ,"Links",10,20,50,20)
mitte% = @Create("Button", %hwnd ,"Mitte",62,20,50,20)
rechts% = @Create("Button", %hwnd ,"Rechts",114,20,50,20)
Var RtfDll&=usedll("msftedit.dll")
ed1&=control("RichEdit50W","",$54015044,10,50,600,480,%hwnd,1234,0,0)
ed2&=control("RichEdit50W","",$54015044,0,0,0,0,%hwnd,1234,0,0)
' ab XProfan X2 auch:
'ed1&=Create("RichEdit", %hwnd, " " | 2,50,10,600,480)
'ed2&=Create("RichEdit", %hwnd, " " | 2, 0,0,0,0)
Create("Text",%hwnd,"Spaltenbreite Tabelle RTF",660,10,160,22)
sed1&=Create("Edit",%hwnd,"200",660,30,40,22)
sed2&=Create("Edit",%hwnd,"200",710,30,40,22)
sed3&=Create("Edit",%hwnd,"200",760,30,40,22)
SetEditNumeric(sed1&)
SetEditNumeric(sed2&)
SetEditNumeric(sed3&)
Text$ = "Links;0;80" +\
";Mitte;2;80"+\
";Rechts;1;80"
Grid1& = Create("GridBox", %hwnd, Text$, 0, 615, 80, 260, 200)
AddString(Grid1&, "Artikel|Datum|Preis")
AddString(Grid1&, "Tisch|22.04.2010|1200,00")
AddString(Grid1&, "Kiste|22.04.2011|23,88")
AddString(Grid1&, "Stuhl|22.04.2011|220,00")
AddString(Grid1&, "|Summe|1443,88")
but&=Create("Button",%hwnd,"Tabelle Einfügen",620,294,244,24)
Create("Text",%hwnd,"Anzahl der Zeilen",730,350,160,22)
row&=Create("Edit",%hwnd,"2",660,346,40,22)
SetEditNumeric(row&)
Create("Text",%hwnd,"Fonthöhe",730,374,160,22)
hfont&=Create("Edit",%hwnd,"12",660,370,40,22)
SetEditNumeric(hfont&)
but_L&=Create("Button",%hwnd,"Leertabelle Einfügen",620,398,244,24)
sich&=Create("Button",%hwnd,"Speichern",760,436,100,24)
lade&=Create("Button",%hwnd,"Öffnen",760,462,100,24)
druck&=Create("Button",%hwnd,"Drucken",760,488,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)
Var L_Text%=len(gettext$(Ed1&))
While 1
If L_Text%<>len(gettext$(Ed1&))
Redraw(Ed1&)' ist erforderlich nach Löschen von Zeilen der Tabelle
L_Text%=len(gettext$(Ed1&))
EndIf
WaitInput
case %key=2:BREAK
IF GetFocus(But&)
' hier sollten für die Spalten, -Breiten und Überschriften die Werte aus der
' Gridbox ermittelt werden.
Decimals 0
sed1%=int(val(GetText$(sed1&))*10)
sed2%=int(val(GetText$(sed2&))*10)
sed3%=int(val(GetText$(sed3&))*10)
case (sed1%+sed2%+sed3%) > 0 : RTF_Zeile
SetFocus(%hWnd)
ElseIF GetFocus(But_L&)
Decimals 0
sed1%=int(val(GetText$(sed1&))*10)
sed2%=int(val(GetText$(sed2&))*10)
sed3%=int(val(GetText$(sed3&))*10)
hfont%=int(val(GetText$(hfont&))*2)' Faktor ggf. anpassen
case (sed1%+sed2%+sed3%) > 0 : RTF_Leer_Zeile
SetFocus(%hWnd)
ElseIf GetFocus(sich&)
Text$ = @SaveFile$("Speichern","Neu.rtf")
case Len(trim$(Text$))>0 : call(&SaveRTF,Ed1&,addr(Text$))
ElseIf GetFocus(lade&)
Text$ = @LoadFile$("ÖFFNE:","*.rtf")
case Len(trim$(Text$))>0 : Rtf("LoadRTF",Ed1&,text$)
ElseIf GetFocus(druck&)
startprint "*xx"
DrawRichText2 Ed1&,0,0,600,800
endprint
Elseif getfocus(links%)
SetAlign ed1&, 1
Elseif getfocus(mitte%)
SetAlign ed1&, 3
Elseif getfocus(rechts%)
SetAlign ed1&, 2
EndIf
wend
DeleteObject font&
dispose rtf#
FreeDLL RtfDll&
End
proc SetAlign
parameters RTF&, a%
clear rtf#
long rtf#,0=156
long rtf#,4=8
word rtf#,24=a%
sendmessage(RTF&,$447,0,rtf#)'-EM_SETPARAFORMAT
endproc
Proc RTF_Zeile
Assign #1,"Tabelle.rtf"
Rewrite #1
Print #1,"{\\rtf1\\ansi\\"+ \
"ansicpg1252\\deff0\\deflang1049\\deflangfe1049{\\fonttbl{\\"+ \
"f0\\fnil\\fcharset0 Arial;}}"
Print #1,"\\viewkind4\\uc1"
WhileLoop 0,GetCount(grid1&)-1,1
Print #1,"{\\trowd\\trhdr\\trgaph30\\trleft0\\trrh262"
Print #1, "\\cellx"+str$(sed1%)+ \
"\\cellx"+str$(sed1%+sed2%)+ \
"\\cellx"+Str$(sed1%+sed2%+sed3%)+"\\pard"
'\b\f1...fett
'ql..Ausrichtung links
'qc..Ausrichtung zentriert
'qr..Ausrichtung rechts
If &loop=0
Print #1, "\\intbl\\ql\\lang1049\\b\\f1\\fs20 " +trim$(Gettext$(Grid1&,&loop,0))+" \\cell\\pard"
Print #1, "\\intbl\\qc "+trim$(Gettext$(Grid1&,&loop,1)) +" \\cell\\pard"
Print #1, "\\intbl\\qr "+trim$(Gettext$(Grid1&,&loop,2)) +" \\cell\\pard"
Print #1, "\\intbl\\row}"
Else
Print #1, "\\intbl\\ql\\lang1049\\fs20 " +trim$(Gettext$(Grid1&,&loop,0))+" \\cell\\pard"
Print #1, "\\intbl\\qc "+trim$(Gettext$(Grid1&,&loop,1)) +" \\cell\\pard"
Print #1, "\\intbl\\qr "+trim$(Gettext$(Grid1&,&loop,2)) +" \\cell\\pard"
Print #1, "\\intbl\\row}"
EndIf
EndWhile
Close #1
Rtf("LoadRTF",ed2&,"Tabelle.rtf")
SetFocus(ed2&)
sendmessage(ed2&,$00B1,0,-1)
Sendmessage(ed2&,$301,0,0)
Sendmessage(ed1&,$302,0,0)
SetFocus(ed1&)
EndProc
Proc RTF_Leer_Zeile
Assign #1,"Tabelle.rtf"
Rewrite #1
Print #1,"{\\rtf1\\ansi\\"+ \
"ansicpg1252\\deff0\\deflang1049\\deflangfe1049{\\fonttbl{\\"+ \
"f0\\fnil\\fcharset0 Arial;}}"
Print #1,"\\viewkind4\\uc1"
WhileLoop val(Gettext$(row&))
Print #1,"{\\trowd\\trhdr\\trgaph30\\trleft0\\trrh262"
Case sed1%>0 : text$ = "\\cellx"+str$(sed1%)
Case sed2%>0 : text$ = text$ + "\\cellx"+str$(sed1%+sed2%)
Case sed3%>0 : text$ = text$ + "\\cellx"+str$(sed1%+sed2%+sed3%)
Print #1, text$+"\\pard"
'ql..Ausrichtung links
'qc..Ausrichtung zentriert
'qr..Ausrichtung rechts
'fs..Fonthöhe
Case sed1%>0 : Print #1, "\\intbl\\ql\\lang1049\\fs"+str$(hfont%)+"\\cell\\pard"
Case sed2%>0 : Print #1, "\\intbl\\qc\\cell\\pard"
Case sed3%>0 : Print #1, "\\intbl\\qr\\cell\\pard"
Print #1, "\\intbl\\row}"
EndWhile
Close #1
Rtf("LoadRTF",ed2&,"Tabelle.rtf")
SetFocus(ed2&)
sendmessage(ed2&,$00B1,0,-1)
Sendmessage(ed2&,$301,0,0)
Sendmessage(ed1&,$302,0,0)
SetFocus(ed1&)
EndProc
proc DrawRichText2'------------------von pascal-------------------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
changed 19.11.12: Backslash through Doppelbackslash supplant and Fonthöhe eingefügt.
changed 27.11.12: attachment with the RTFHandling.pcu of Dieter Z. prepares.
 |
 | | | | Gruß Thomas
Windows XP SP2, XProfan X2 | 11/18/12 ▲ |
| | |
| | | | | | - Page 2 - |
| |  | | | | | | | |
| |
Thomas
Freier | means have I it once with XPSE {I} attempts, and the first Error Message was
CompileMarkSeparation. is presumably in this code neither More necessary. The RTF becomes too without tidy created.
whom Restmecker To Create.... eliminating and zero Error.
in the code have I now Print #1,"\par}" removes and the Repaint differently organisiert. |
| | | | Gruß Thomas
Windows XP SP2, XProfan X2 | 11/20/12 ▲ |
| | |
| | 
Jörg
Sellmeyer | Thomas suitor (20.11.12)
whom Restmecker To Create.... eliminating and zero Error.
are you sure, that You the removes have?
CompileMarkSeparationCreateText(%hwnd,"Spaltenbreite Tabelle RTF",660,10,160,22)
sed1&=CreateEdit(%hwnd,"200",660,30,40,22)
sed2&=CreateEdit(%hwnd,"200",710,30,40,22)
sed3&=CreateEdit(%hwnd,"200",760,30,40,22)pre>
the ought to your X2-Version but really not without further to accept.
Also row 18:
dim rtf#,60Var L_Text%=len(gettext$(Ed1&))
and Var L_Text%=len(gettext$(Ed1&)) diving twice on.
and the space in the RTF-Codierungszeile bang still everything out.
either are you already Thomas installed (but Why ought to it) or the Codeformatierer power that here.
CompileMarkSeparationPrint #1,"{\\rtf1\\ansi\\"+ \
"ansicpg1252\\deff0\\deflang1049\\deflangfe1049{\\fonttbl{\\"+ \
"f0\\fnil\\fcharset0 Arial;}}"re>
P.s.
The Lines Have I without Leerzeilen association and sustain which with Leerzeilen... |
| | | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ...  | 11/20/12 ▲ |
| | |
| |
Thomas
Freier | | there was here at Change/ replace something schief run. have I now renewed. whether the now everything with XPSE goes? And if not, should itself the users circa Alternativen bemühen. with X2 runs it by me. |
| | | | Gruß Thomas
Windows XP SP2, XProfan X2 | 11/20/12 ▲ |
| | |
| | | Runs through without To grumble! 
 |
| | | | | | |
| |
Thomas
Freier | by me wars, XPSE as Interpreter chosen, once OK. today I get The Error Message : undeclariert: UNSET.
on the Codeanfang I had { I } registered. is not OK?
The Buchstabenkombination UNSET is anyway No. |
| | | | Gruß Thomas
Windows XP SP2, XProfan X2 | 11/20/12 ▲ |
| | |
| | | alas you mean Kompilerschalter -
The begin always with {$...} -
means for "Interpreter" simply {$i} write -
or {$iq} for "Interpreter","quiet,XPSE-Window automatically close to Programmende".
I use mostly {$cleq} for "compile","link","execute","quiet".
here The list: [...]  |
| | | | | | |
| |
Jörg
Sellmeyer | | The code functions now free from problems but first, after I again Leerzeilen removes Have, The the Formatiertool here einfügt (s.o.) |
| | | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 11/20/12 ▲ |
| | |
| | | Hm I kanns not reproduzieren -
where out copy You code the then of these Leerzeilen umgesetzt becomes? |
| | | | | | |
| |
Jörg
Sellmeyer | from the XProfEd:
so see it original from:
Print #1,"{\\rtf1\\ansi\\"+ \
"ansicpg1252\\deff0\\deflang1049\\deflangfe1049{\\fonttbl{\\"+ \
"f0\\fnil\\fcharset0 Arial;}}"
and so as formatierter QT:
CompileMarkSeparationPrint #1,"{\\rtf1\\ansi\\"+ \
"ansicpg1252\\deff0\\deflang1049\\deflangfe1049{\\fonttbl{\\"+ \
"f0\\fnil\\fcharset0 Arial;}}"re>
and the Leerzeilen go of Profan then naturally not as disruption the Codezeile recognized. |
| | | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 11/20/12 ▲ |
| | |
| | | Ah,
Verursacher { found -
behebe + thanks! |
| | | | | | |
| | | | | | | | | |
|
Zum QuelltextTopic-Options | 23.129 Views |
Themeninformationenthis Topic has 4 subscriber: |
(897)
Deutsch
English
Français
Español
Italia
