Italia
Fonte/ Codesnippets

Richedit Tabelle

 

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 possibile.
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.


400 kB
Hochgeladen:27.11.2012
Downloadcounter265
Download
116 kB
Hochgeladen:27.11.2012
Downloadcounter224
Download
 
Gruß Thomas
Windows XP SP2, XProfan X2
18.11.2012  
 




Jörg
Sellmeyer
Ist bestimmt klasse. Allerdings corre das so nicht bei mir durch. Ich vermute mal, dass das mit den ganzen Backslashes in Literalen zusammenhängt.
Jedenfalls knallt es hier:
KompilierenMarkierenSeparieren
Print #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.

File: 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:>
 
19.11.2012  
 




Thomas
Freier
Ist das Problem so behoben?
KompilierenMarkierenSeparieren
Text$="{\"+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, Te
pre>

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 Io l' Backslash durch chr$(092) ersetzen. Kurztest war OK.
 
Gruß Thomas
Windows XP SP2, XProfan X2
19.11.2012  
 



Warnung: Unbekannte Escapesequenz in Stringkonstante: "nsicpg1
252\deff0\deflang1049\deflangfe1049{\"


Einfach mal xpse drüberjagen hilft doch ungemein.

Mach doch aus Deinen Backslashes \ Doppelbackslashes \\.
 
19.11.2012  
 




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.
 
19.11.2012  
 



E.T. (19.11.12)


[OFFTOPIC]Was macht IF um diese Zeit noch hier und ist schneller als ich ??[/OFFTOPIC]




Schlafstörungen!
 
19.11.2012  
 




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 X2
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  
 




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.
 
Gruß Thomas
Windows XP SP2, XProfan X2
19.11.2012  
 




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 Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Topic-Options

23.595 Views

Untitledvor 0 min.
Gast.081503.10.2024
Walter19.07.2024
Thomas Freier01.01.2024
Frank Reibold25.11.2022
Di più...

Themeninformationen



Admins  |  AGB  |  Applications  |  Autori  |  Chat  |  Informativa sulla privacy  |  Download  |  Entrance  |  Aiuto  |  Merchantportal  |  Impronta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Giochi  |  Cerca  |  Support

Ein Projekt aller XProfaner, die es gibt!


Il mio XProfan
Private Notizie
Eigenes Ablageforum
Argomenti-Merkliste
Eigene Beiträge
Eigene Argomenti
Zwischenablage
Annullare
 Deutsch English Français Español Italia
Traduzioni

Informativa sulla privacy


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Ich möchte keinen Cookie