Source / code snippets | | | | | 
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 ▲ |
| | |
| | 
Jörg
Sellmeyer | Is determined class. though runs the so not me through. I suspect time, that with the whom whole Backslashes in Literalen zusammenhängt.
anyway knallt it here:
CompileMarkSeparationPrint #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;}}"re> |
| | | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ...  | 11/19/12 ▲ |
| | |
| |  | XProfan 11.2.1.8a.63 Praekompiler [XPSE] copyright (C) 1998-2010 XProfan.com, built DE. File: document1.xprf warning: Unknown 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 | is the trouble so fixed?
CompileMarkSeparationText$="{\"+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, Tepre>
or \d is the trouble and should through "+chr$(100)+" supplant go.
self I had yet no trouble, can but of BS tributary his.
ought to it so his, I will any letters to the Backslash supplant.
PS. Perhaps ought to I the Backslash through chr$(092) supplant. Kurztest was OK. |
| | | | Gruß Thomas
Windows XP SP2, XProfan X2 | 11/19/12 ▲ |
| | |
| | | warning: Unknown Escapesequenz in Stringkonstante: "nsicpg1 252\deff0\deflang1049\deflangfe1049{\"
simply time xpse drüberjagen helps still ungemein.
Mach still from your Backslashes \ Doppelbackslashes \\. |
| | | | | | |
| | 
E.T. | and what speaks dagegend, The "\" through "\\" To supplant ??
so the from
...52\deff0\deflang1049\deflangf...
simply
...52\\deff0\\deflang1049\\deflangf...
becomes ??
so has XPSE nothing More To meckern, and the XProfan something, what with "\\" begins as Escape-sequence interprets, is me sincere said not yet happens (ought to indeed intern not occur).
I pers. Have me these spelling already long angewöhnt (dank XPSE). having recently these Discussion too with Dietmar, this was too of "\\" not convincing. somehow having z.Zt. well any fear, the one "\\b" als "Backspace" or one "\\t" as "Tabulator" interprets becomes.
only unfortunately can none an example bring, where this too happens 
would be me still interested, what Roland moreover means ... 
[OFFTOPIC]what power IF circa these Time yet here and is faster as i ?? [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... | 11/19/12 ▲ |
| | |
| | |
somehow having z.Zt. well any fear, the one "\\b" as "Backspace" or one "\\t" as "Tabulator" interprets becomes.
Why should tappt im dunkeln? \\b yields \b and not chr(8). wants one \b repräsentieren
writes one hold \\b and who \\ need writes \\\\ -
is programmierprachenübergreifend quite uniform umgesetzt. |
| | | | | | |
| | | E.T. (19.11.12)
[OFFTOPIC]what power IF circa these Time yet here and is faster as i ??[/OFFTOPIC]
insomnia!  |
| | | | | | |
| |
E.T. | iF (19.11.12)
iF (19.11.12)somehow having z.Zt. well any fear, the one "\\b" as "Backspace" or one "\\t" as "Tabulator" interprets becomes. Why should tappt im dunkeln? \\b yields \b and not chr(8). wants one \b repräsentieren writes one hold \\b and who \\ need writes \\\\ - is programmierprachenübergreifend quite uniform umgesetzt.
Well, Dietmar having already The idea, any Backslash (\)through Slash (/) To supplant.
see I but none sense drinn, we proggen still no 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... | 11/19/12 ▲ |
| | |
| |
E.T. |
insomnia!
certainly disturbances in the Matrix, ohjeh, again what To repair...  |
| | | | 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... | 11/19/12 ▲ |
| | |
| |
Thomas
Freier | | OK. you have me convincing what about me have whom code adjusted. |
| | | | Gruß Thomas
Windows XP SP2, XProfan X2 | 11/19/12 ▲ |
| | |
| |
Jörg
Sellmeyer | I hab's. it's located on whom Leerzeilen, The iFs Codeformator einfügt - irrespective whom einfachen Backslashes.
@iF: you should the Formatierer procure, to one abschließenden \ no Leerzeile inzufügen. |
| | | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 11/19/12 ▲ |
| | |
|
Zum QuelltextTopic-Options | 23.690 Views |
Themeninformationenthis Topic has 4 subscriber: |
(948)
Deutsch
English
Français
Español
Italia