English
Source / code snippets

Richedit scheduler

 

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.


400 kB
Hochgeladen:11/27/12
Downloadcounter267
Download
116 kB
Hochgeladen:11/27/12
Downloadcounter225
Download
 
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:
CompileMarkSeparation
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 ...
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:>
 
11/19/12  
 




Thomas
Freier
is the trouble so fixed?
CompileMarkSeparation
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>

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 \\.
 
11/19/12  
 




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.
 
11/19/12  
 



E.T. (19.11.12)


[OFFTOPIC]what power IF circa these Time yet here and is faster as i ??[/OFFTOPIC]




insomnia!
 
11/19/12  
 




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


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

23.695 Views

Untitledvor 0 min.
Gast.0815Gestern (15:30)
Walter07/19/24
Thomas Freier01/01/24
Frank Reibold11/25/22
More...

Themeninformationen



Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.


all rightDatenschutzerklärung
i want none Cookie