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 - |
| 
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! |
| | | | | | |
| | | | | | | | | |
| | | | | | - Page 3 - |
| |
Jörg
Sellmeyer | | I Have Thomas' Text again new stored and now shining it To functions. thanks |
| | | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 11/20/12 ▲ |
| | |
| |
Thomas
Freier | | | | | Gruß Thomas
Windows XP SP2, XProfan X2 | 11/27/12 ▲ |
| | |
|
Zum QuelltextTopic-Options | 23.766 Views |
Themeninformationenthis Topic has 4 subscriber: |
(912)
Deutsch
English
Français
Español
Italia
