Fuente/ Codesnippets | | | | | 
Thomas
Freier | Ab Modus 2 (de XP SP1) puede en el RichEdit Tabellen, deren Texto mittig oder rechtsbündig ausgerichtet es, eingesetzt voluntad. Yo verwende lo a Gestaltung sin Gitterlinien. Ein Item kann, bleibe en el Begriff de el Gridbox, una mehrzeiligen Texto, Bilder oder weitere Tabellen enthalten. Un Ausrichtung es en cada Item posible.
Ein kleines Ejemplo (Auszug)
KompilierenMarcaSeparación $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 por Doppelbackslash ersetzt y Fonthöhe eingefügt.
Geändert 27.11.12: Anhang con el RTFHandling.pcu de Dieter Z. erstellt.
 |
 | | | | | | |
| | 
Jörg
Sellmeyer | Está decidido klasse. Aunque se ejecuta el así no en me por. Yo vermute veces, dass el con el ganzen Backslashes en Literalen zusammenhängt.
Jedenfalls knallt lo hier:
KompilierenMarcaSeparaciónPrint #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 ...  | 19.11.2012 ▲ |
| | |
| |  | XProfan 11.2.1.8a.63 Praekompiler [XPSE] Copyright (C) 1998-2010 XProfan.Com, built DE. Expediente: dokument1.xprf Warnung: Unbekannte Escapesequenz en 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 el problema así Fijo?
KompilierenMarcaSeparaciónText$="{\"+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>
oder \d el problema es y debería por "+chr$(100)+" ersetzt voluntad.
Selbst Tuve bisher kein Problema, kann aber vom BS abhängig ser.
Sollte lo así ser, voluntad Yo todos Buchstaben después de el Backslash sustituir.
PS. Tal vez debería Yo, el Backslash por chr$(092) sustituir. Kurztest war OK. |
| | | | | | |
| | | Warnung: Unbekannte Escapesequenz en Stringkonstante: "nsicpg1 252\deff0\deflang1049\deflangfe1049{\"
Einfach veces xpse drüberjagen hilft doch ungemein.
Mach doch de Su Backslashes \ Doppelbackslashes \\. |
| | | | | | |
| | 
E.T. | Und qué spricht dagegend, el "\" por "\\" a sustituir ??
So el de
...52\deff0\deflang1049\deflangf...
simplemente
...52\\deff0\\deflang1049\\deflangf...
se ??
So ha XPSE nix mehr a meckern, y el XProfan irgendetwas, qué con "\\" beginnt como Escape-Sequenz interpretiert, me está ehrlich dijo todavía no passiert (debería en efecto intern no passieren).
Yo pers. tener me esta Schreibweise ya largo angewöhnt (dank XPSE). Hatte letztens esta Diskussion auch con Dietmar, dieser fue de "\\" no überzeugt. Irgendwie haben z.Zt. wohl todos Angst, el una "\\b" als "Backspace" oder una "\\t" como "Tabulator" interpretiert se.
Nur desafortunadamente kann keiner una Ejemplo bringen, wo dies auch passiert 
Würde mich doch interés, qué Roland dazu meint ... 
[OFFTOPIC]Was macht IF en esta Tiempo todavía hier y es más rápido como Yo ?? [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 todos Angst, el una "\\b" como "Backspace" oder una "\\t" como "Tabulator" interpretiert se.
¿Por qué debería ellos? \\b ergibt \b y no chr(8). Will uno \b repräsentieren
schreibt uno sólo \\b y wer \\ braucht schreibt \\\\ -
el se programmierprachenübergreifend bastante einheitlich umgesetzt. |
| | | | | | |
| | | E.T. (19.11.12)
[OFFTOPIC]Was macht IF en esta Tiempo todavía hier y es más rápido como Yo ??[/OFFTOPIC]
Schlafstörungen!  |
| | | | | | |
| |
E.T. | IF (19.11.12)
IF (19.11.12)Irgendwie haben z.Zt. wohl todos Angst, el una "\\b" como "Backspace" oder una "\\t" como "Tabulator" interpretiert se. ¿Por qué debería ellos? \\b ergibt \b y no chr(8). Will uno \b repräsentieren schreibt uno sólo \\b y wer \\ braucht schreibt \\\\ - el se programmierprachenübergreifend bastante einheitlich umgesetzt.
Naja, Dietmar había el Concepto, todos Backslash (\)por Slash (/) a sustituir.
Sehe Yo aber no 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 en el Matrix, ohjeh, otra vez qué a 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 y yo habe el código adaptado. |
| | | | | | |
| |
Jörg
Sellmeyer | Yo hab's. Lo liegt a el Leerzeilen, el iFs Codeformator einfügt - abgesehen de los einfachen Backslashes.
@IF: du solltest el Formatierer beibringen, una abschließenden \ no Leerzeile inzufügen. |
| | | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 19.11.2012 ▲ |
| | |
|
Zum QuelltextTema opciones | 23.734 Views |
ThemeninformationenDieses Thema ha 4 subscriber: |
(921)
Deutsch
English
Français
Español
Italia