XProfan

 $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

CreateText(%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>

Print #1,"{\\rtf1\\ansi\\"+ \
"ansicpg1252\\deff0\\deflang1049\\deflangfe1049{\\fonttbl{\\"+ \
"f0\\fnil\\fcharset0 Arial;}}"re>

Print #1,"{\\rtf1\\ansi\\"+ \
"ansicpg1252\\deff0\\deflang1049\\deflangfe1049{\\fonttbl{\\"+ \
"f0\\fnil\\fcharset0 Arial;}}"re>

Print #1,"{\\rtf1\\ansi\\"+ \
"ansicpg1252\\deff0\\deflang1049\\deflangfe1049{\\fonttbl{\\"+ \
"f0\\fnil\\fcharset0 Arial;}}"re>

;function source_core_countchars($txt,$ch){

    ;$txt=preg_replace("(\".*?\")","",$txt)
    ;return strlen($txt)-strlen(str_replace($ch,"",$txt))

;}<