Quelltexte/ Codesnippets | | | | | 
Thomas
Freier | Ab Modus 2 (ab XP SP1) können im RichEdit Tabellen, deren Text mittig oder rechtsbündig ausgerichtet ist, eingesetzt werden. Ich verwende es zur Gestaltung ohne Gitterlinien. Ein Item kann, bleibe bei dem Begriff aus der Gridbox, einen mehrzeiligen Text, Bilder oder weitere Tabellen enthalten. Eine Ausrichtung ist in jedem Item möglich.
Ein kleines Beispiel (Auszug)
KompilierenMarkierenSeparieren $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
Geändert 19.11.12: Backslash durch Doppelbackslash ersetzt und Fonthöhe eingefügt.
Geändert 27.11.12: Anhang mit der RTFHandling.pcu von Dieter Z. erstellt.
 |
 | | | | | | |
| | 
Jörg
Sellmeyer | Ist bestimmt klasse. Allerdings läuft das so nicht bei mir durch. Ich vermute mal, dass das mit den ganzen Backslashes in Literalen zusammenhängt.
Jedenfalls knallt es hier:
KompilierenMarkierenSeparierenPrint #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;}}"
|
| | | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ...  | 19.11.2012 ▲ |
| | |
| |  | XProfan 11.2.1.8a.63 Praekompiler [XPSE] Copyright (C) 1998-2010 XProfan.Com, built DE. Datei: dokument1.xprf Warnung: Unbekannte Escapesequenz in Stringkonstante: "nsicpg1 252\deff0\deflang1049\deflangfe1049{\" [C]ompile [I]nterpr [L]ink [R]unPrc Run[E]xe [S]ource [H]ilfe XPSE:>  |
| | | | | | |
| |
Thomas
Freier | Ist das Problem so behoben?
KompilierenMarkierenSeparierenText$="{\"+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, Text$
oder \d ist das Problem und müsste durch "+chr$(100)+" ersetzt werden.
Selbst hatte ich bisher kein Problem, kann aber vom BS abhängig sein.
Sollte es so sein, werde ich alle Buchstaben nach dem Backslash ersetzen.
PS. Vielleicht sollte ich den Backslash durch chr$(092) ersetzen. Kurztest war OK. |
| | | | | | |
| | | Warnung: Unbekannte Escapesequenz in Stringkonstante: "nsicpg1 252\deff0\deflang1049\deflangfe1049{\"
Einfach mal xpse drüberjagen hilft doch ungemein.
Mach doch aus Deinen Backslashes \ Doppelbackslashes \\. |
| | | | | | |
| | 
E.T. | Und was spricht dagegend, die "\" durch "\\" zu ersetzen ??
So das aus
...52\deff0\deflang1049\deflangf...
einfach
...52\\deff0\\deflang1049\\deflangf...
wird ??
So hat XPSE nix mehr zu meckern, und das XProfan irgendetwas, was mit "\\" beginnt als Escape-Sequenz interpretiert, ist mir ehrlich gesagt noch nicht passiert (sollte ja auch intern nicht passieren).
Ich pers. hab mir diese Schreibweise schon lange angewöhnt (dank XPSE). Hatte letztens diese Diskussion auch mit Dietmar, dieser war auch von "\\" nicht überzeugt. Irgendwie haben z.Zt. wohl alle Angst, das ein "\\b" als "Backspace" oder ein "\\t" als "Tabulator" interpretiert wird.
Nur leider kann keiner ein Beispiel bringen, wo dies auch passiert 
Würde mich doch interessieren, was Roland dazu meint ... 
[OFFTOPIC]Was macht IF um diese Zeit noch hier und ist schneller als ich ?? [OFFTOPIC] |
| | | | Grüße aus Sachsen... Mario  WinXP, Win7 (64 Bit),Win8(.1),Win10, Win 11, Profan 6 - X4, XPSE, und 'nen schwarzes, blinkendes Dingens, wo ich das alles reinschütte... | 19.11.2012 ▲ |
| | |
| | |
Irgendwie haben z.Zt. wohl alle Angst, das ein "\\b" als "Backspace" oder ein "\\t" als "Tabulator" interpretiert wird.
Wieso sollten sie? \\b ergibt \b und nicht chr(8). Will man \b repräsentieren
schreibt man halt \\b und wer \\ braucht schreibt \\\\ -
das wird programmierprachenübergreifend ziemlich einheitlich umgesetzt. |
| | | | | | |
| | | E.T. (19.11.12)
[OFFTOPIC]Was macht IF um diese Zeit noch hier und ist schneller als ich ??[/OFFTOPIC]
Schlafstörungen!  |
| | | | | | |
| |
E.T. | iF (19.11.12)
iF (19.11.12)Irgendwie haben z.Zt. wohl alle Angst, das ein "\\b" als "Backspace" oder ein "\\t" als "Tabulator" interpretiert wird. Wieso sollten sie? \\b ergibt \b und nicht chr(8). Will man \b repräsentieren schreibt man halt \\b und wer \\ braucht schreibt \\\\ - das wird programmierprachenübergreifend ziemlich einheitlich umgesetzt.
Naja, Dietmar hatte schon die Idee, alle Backslash (\)durch Slash (/) zu ersetzen.
Sehe ich aber keinen sinn drinn, wir proggen doch kein html.... |
| | | | XProfan X2Grüße aus Sachsen... Mario WinXP, Win7 (64 Bit),Win8(.1),Win10, Win 11, Profan 6 - X4, XPSE, und 'nen schwarzes, blinkendes Dingens, wo ich das alles reinschütte... | 19.11.2012 ▲ |
| | |
| |
E.T. |
Schlafstörungen!
Bestimmt Störungen in der Matrix, ohjeh, wieder was zu reparieren...  |
| | | | Grüße aus Sachsen... Mario WinXP, Win7 (64 Bit),Win8(.1),Win10, Win 11, Profan 6 - X4, XPSE, und 'nen schwarzes, blinkendes Dingens, wo ich das alles reinschütte... | 19.11.2012 ▲ |
| | |
| |
Thomas
Freier | | OK. Ihr habt mich überzeugt und ich habe den Code angepasst. |
| | | | | | |
| |
Jörg
Sellmeyer | Ich hab's. Es liegt an den Leerzeilen, die iFs Codeformator einfügt - abgesehen von den einfachen Backslashes.
@iF: du solltest dem Formatierer beibringen, nach einem abschließenden \ keine Leerzeile inzufügen. |
| | | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 19.11.2012 ▲ |
| | |
|
Zum QuelltextThemenoptionen | 23.658 Betrachtungen |
ThemeninformationenDieses Thema hat 4 Teilnehmer: |
(933)
Deutsch
English
Français
Español
Italia