Building a vfp navigable richtextbox

Published on by Yousfi Benameur

The richtextbox is an activeX ("RICHTEXT.RichtextCtrl.1") shipped with visual foxpro and can be used for making rich texts.

I make this demo  example with goal to be independent of any external resources (as dbf,images,embedd texts ...)

Select the code and paste into yrichtextbox.prg and run.Test all coded  functions .

Can see some screenshots below the code.

The richtextbox can embed unicode languages as shown with arabic.

The original application included many containers.I simplified it to translate to a prg file.

*Warning: the richtext provider  editor have many caveats and cut time to time the end code lines.please verify before after pasting code.I notified the provider with this problem.

 

*Begin code
Close Data All

create cursor yrtf (source m)
text to m.myvar noshow
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Proin vel risus eget lorem feugiat fermentum nec a turpis. Phasellus purus sem, mollis ac
posuere eget, ornare vel orci. Sed ac rutrum nulla. Aenean ultrices eget lectus eu efficitur. In hac habitasse platea dictumst. Nulla in iaculis nisi.
Nullam et pulvinar tellus. Donec arcu dui, efficitur a odio non, porta congue dolor. Aenean viverra auctor sagittis. Integer lobortis dignissim auctor.
Proin et volutpat massa.
Cras vitae felis venenatis, egestas sem quis, sodales neque. Donec venenatis hendrerit odio, non pellentesque metus scelerisque ac. Suspendisse
aliquet rhoncus odio id viverra. Vestibulum feugiat lectus a nisl pulvinar, in tempor metus eleifend. Nunc id odio quam. Praesent egestas lorem ut
sollicitudin consectetur. Vestibulum id bibendum est. Ut vel lacus sapien. Quisque eget molestie sem. Integer eget purus eu orci molestie aliquam
quis in ante. Integer a magna eget lectus finibus porttitor. Donec fringilla sapien a quam aliquet, pellentesque blandit nisl placerat. Nam hendrerit
velit vel ex aliquam, eget convallis ante mollis.
endtext
for i=1 to 6
insert into yRTF values(trans(i)+chr(13)+chr(10)+m.myvar)
endfor
sele yrtf
*brow
locate


Set Classlib To  (Home(1)+"samples\solution\solution.vcx")  AddI
Publi yform
yform=Newobject("yrtf_table")
Release Classlib   (Home(1)+"samples\solution\solution.vcx")
yform.Show
Read Events
Return
*

Define Class yrtf_table As Form
    Height = 575
    Width = 911
    ShowWindow = 2
    ShowTips = .T.
    AutoCenter = .T.
    Picture = "fonds1.jpg"  
    Caption = "yRichtextBox"
    MinWidth = 580
    Icon = Home(4)+"icons\misc\lighton.ico"
    HelpContextID = 1231548
    ctext = Chr(13) + Chr(13) + [Name = "Form1"]
    nlargestfont = 48
    nsmallestfont = 6
    ysearch = .F.
    Name = "YRTF"
    *-- Height of the area above the RichText control.
    nstripsize = .F.


    Add Object olertf As OleControl With ;
        oleclass="RICHTEXT.RichtextCtrl.1",;
        Top = 108, ;
        Left = 0, ;
        Height = 468, ;
        Width = 912, ;
        Anchor = 15, ;
        ControlSource = "yrtf.source", ;
        Name = "oleRTF"

    Add Object command3 As CommandButton With ;
        Top = 9, ;
        Left = 487, ;
        Height = 25, ;
        Width = 52, ;
        FontSize = 8, ;
        Caption = "DateTime", ;
        ToolTipText = "Insert dateTime", ;
        Name = "Command3"

    Add Object command2 As CommandButton With ;
        Top = 10, ;
        Left = 538, ;
        Height = 25, ;
        Width = 30, ;
        Caption = "Line", ;
        ToolTipText = "Draw a line", ;
        Name = "Command2"

    Add Object command1 As CommandButton With ;
        Top = 7, ;
        Left = 853, ;
        Height = 44, ;
        Width = 53, ;
        FontBold = .T., ;
        FontSize = 12, ;
        Caption = "Close", ;
        ForeColor = Rgb(0,0,255), ;
        BackColor = Rgb(255,0,0), ;
        Name = "Command1"

    Add Object command4 As CommandButton With ;
        Top = 9, ;
        Left = 567, ;
        Height = 25, ;
        Width = 27, ;
        Caption = "BK", ;
        ToolTipText = "OLERTF Backcolor", ;
        Name = "Command4"

    Add Object spnrightmargin As Spinner With ;
        Comment = "", ;
        Height = 24, ;
        Increment =   5.00, ;
        InputMask = "99999", ;
        KeyboardHighValue = 1000, ;
        KeyboardLowValue = 0, ;
        Left = 595, ;
        SpinnerHighValue = 1000.00, ;
        SpinnerLowValue =   0.00, ;
        TabIndex = 16, ;
        ToolTipText = "Right margin/Line Legth", ;
        Top = 10, ;
        Width = 92, ;
        Value = 710, ;
        ControlSource = "ThisForm.oleRTF.Object.RightMargin", ;
        Name = "spnRightMargin"

    Add Object command5 As CommandButton With ;
        Top = 9, ;
        Left = 729, ;
        Height = 27, ;
        Width = 50, ;
        Picture = Home(4)+"BITMAPS\OFFCTLBR\SMALL\COLOR\print.bmp", ;
        Caption = "Print", ;
        MousePointer = 15, ;
        ToolTipText = "Print oleRTF", ;
        PicturePosition = 0, ;
        Alignment = 4, ;
        Name = "Command5"

    Add Object spnindent As Spinner With ;
        Height = 24, ;
        Increment =   5.00, ;
        InputMask = "99999", ;
        KeyboardHighValue = 500, ;
        KeyboardLowValue = 0, ;
        Left = 434, ;
        SpinnerHighValue = 500.00, ;
        SpinnerLowValue =   0.00, ;
        TabIndex = 16, ;
        ToolTipText = "selection Left margin", ;
        Top = 10, ;
        Width = 54, ;
        Value = 25, ;
        ControlSource = "ThisForm.oleRTF.Object.selindent", ;
        Name = "spnIndent"

    Add Object vcr1 As vcr With ;
        Top = 38, ;
        Left = 5, ;
        Width = 104, ;
        Height = 24, ;
        enabledisableoninit = .T., ;
        skiptable = "yRTF", ;
        Name = "Vcr1", ;
        cmdTop.Caption = "|<", ;
        cmdTop.Name = "cmdTop", ;
        cmdPrior.Caption = "<", ;
        cmdPrior.Name = "cmdPrior", ;
        cmdNext.Caption = ">", ;
        cmdNext.Name = "cmdNext", ;
        cmdBottom.Caption = ">|", ;
        cmdBottom.Name = "cmdBottom", ;
        Datachecker1.Height = 15, ;
        Datachecker1.Width = 23, ;
        Datachecker1.Name = "Datachecker1"

    Add Object cmdnew As CommandButton With ;
        Top = 38, ;
        Left = 111, ;
        Height = 24, ;
        Width = 34, ;
        FontName = "MS Sans Serif", ;
        FontSize = 8, ;
        Caption = "\<New", ;
        ToolTipText = "Add New Record", ;
        Name = "cmdNew"


    Add Object label1 As Label With ;
        AutoSize = .T., ;
        FontBold = .T., ;
        FontSize = 16, ;
        BackStyle = 0, ;
        Caption = "", ;
        Height = 27, ;
        Left = 11, ;
        Top = 62, ;
        Width = 2, ;
        ForeColor = Rgb(255,0,0), ;
        Name = "Label1"

    Add Object command7 As CommandButton With ;
        Top = 9, ;
        Left = 824, ;
        Height = 24, ;
        Width = 22, ;
        FontBold = .T., ;
        FontName = "MS Sans Serif", ;
        FontSize = 12, ;
        Caption = "?", ;
        ToolTipText = "Add New Record", ;
        ForeColor = Rgb(255,0,0), ;
        Name = "Command7"

    Add Object command9 As CommandButton With ;
        Top = 36, ;
        Left = 502, ;
        Height = 27, ;
        Width = 108, ;
        FontSize = 8, ;
        Picture = Home(4)+"BITMAPS\OFFCTLBR\SMALL\COLOR\find.bmp", ;
        Caption = "Search Highlight", ;
        ToolTipText = "search word", ;
        PicturePosition = 0, ;
        Name = "Command9"

    Add Object command8 As CommandButton With ;
        Top = 36, ;
        Left = 609, ;
        Height = 27, ;
        Width = 108, ;
        FontSize = 8, ;
        Picture = Home(4)+"BITMAPS\OFFCTLBR\SMALL\COLOR\find.bmp", ;
        Caption = "Search Replace", ;
        PicturePosition = 0, ;
        Name = "Command8"

    Add Object command10 As CommandButton With ;
        Top = 62, ;
        Left = 761, ;
        Height = 27, ;
        Width = 84, ;
        FontSize = 8, ;
        Picture = Home(4)+"BITMAPS\OFFCTLBR\SMALL\COLOR\save.bmp", ;
        Caption = "Save as ..", ;
        ToolTipText = "rtf ot txt", ;
        PicturePosition = 0, ;
        Name = "Command10"

    Add Object command11 As CommandButton With ;
        Top = 36, ;
        Left = 716, ;
        Height = 27, ;
        Width = 97, ;
        FontSize = 8, ;
        Picture = Home(4)+"BITMAPS\OFFCTLBR\SMALL\COLOR\open.bmp", ;
        Caption = "Open RTF-Txt", ;
        ToolTipText = "external rtf,txt", ;
        PicturePosition = 0, ;
        Name = "Command11"

    Add Object command12 As CommandButton With ;
        Top = 9, ;
        Left = 780, ;
        Height = 24, ;
        Width = 45, ;
        FontBold = .T., ;
        FontName = "MS Sans Serif", ;
        FontShadow = .F., ;
        FontSize = 8, ;
        Caption = "Delete", ;
        ToolTipText = "delete this page", ;
        ForeColor = Rgb(255,0,0), ;
        Name = "Command12"

    Add Object label2 As Label With ;
        AutoSize = .T., ;
        FontBold = .T., ;
        FontSize = 9, ;
        Caption = "Char.Sp.", ;
        Height = 17, ;
        Left = 365, ;
        MousePointer = 15, ;
        Top = 14, ;
        Width = 50, ;
        BackColor = Rgb(255,255,0), ;
        ToolTipText = "Copy special Character", ;
        Name = "Label2"


    Add Object command13 As CommandButton With ;
        Top = 62, ;
        Left = 853, ;
        Height = 27, ;
        Width = 47, ;
        Caption = "Arabic", ;
        Name = "Command13"

    Add Object check1 As Checkbox With ;
        Top = 64, ;
        Left = 290, ;
        Height = 16, ;
        Width = 91, ;
        FontSize = 8, ;
        AutoSize = .T., ;
        Alignment = 0, ;
        BackStyle = 0, ;
        Caption = "AutoVerbmenu", ;
        MousePointer = 15, ;
        Style = 0, ;
        ToolTipText = "On rightClick", ;
        ForeColor = Rgb(255,0,0), ;
        Name = "Check1"

    Add Object check2 As Checkbox With ;
        Top = 68, ;
        Left = 654, ;
        Height = 16, ;
        Width = 87, ;
        FontSize = 8, ;
        AutoSize = .T., ;
        Alignment = 0, ;
        BackStyle = 0, ;
        Caption = "Protected  sel.", ;
        MousePointer = 15, ;
        Style = 0, ;
        ToolTipText = "Protect  exact selection or Unprotect", ;
        ForeColor = Rgb(255,0,0), ;
        Name = "Check2"

    Add Object spinner1 As Spinner With ;
        Height = 25, ;
        KeyboardHighValue = 5, ;
        KeyboardLowValue = 1, ;
        Left = 690, ;
        SpinnerHighValue =   5.00, ;
        SpinnerLowValue =   1.00, ;
        ToolTipText = "Themes", ;
        Top = 11, ;
        Width = 37, ;
        Value = 1, ;
        Name = "Spinner1"

    Add Object cbofontname1 As ComboBox With ;
        Height = 25, ;
        Left = 7, ;
        ToolTipText = "Fontname", ;
        Top = 6, ;
        Width = 120, ;
        Name = "cboFontname1"

    Add Object cbofontsize1 As ComboBox With ;
        Height = 25, ;
        Left = 133, ;
        ToolTipText = "Fontsize", ;
        Top = 6, ;
        Width = 48, ;
        Name = "cboFontsize1"

    Add Object cmdbold As CommandButton With ;
        Top = 6, ;
        Left = 180, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontName = "Courier New", ;
        FontSize = 8, ;
        Caption = "B", ;
        ToolTipText = "Bold", ;
        Name = "cmdBold"

    Add Object command6 As CommandButton With ;
        Top = 6, ;
        Left = 204, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontName = "Courier New", ;
        FontSize = 8, ;
        Caption = "I", ;
        ToolTipText = "Italic", ;
        Name = "Command6"

    Add Object command14 As CommandButton With ;
        Top = 6, ;
        Left = 228, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontName = "Courier New", ;
        FontSize = 8, ;
        Caption = "C", ;
        ToolTipText = "Color", ;
        ForeColor = Rgb(255,0,0), ;
        Name = "Command14"

    Add Object command15 As CommandButton With ;
        Top = 6, ;
        Left = 252, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontUnderline = .T., ;
        Caption = "U", ;
        ToolTipText = "Underline", ;
        Name = "Command15"

    Add Object command16 As CommandButton With ;
        Top = 6, ;
        Left = 276, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontSize = 8, ;
        Caption = "Sb", ;
        MousePointer = 15, ;
        ToolTipText = "Subscript", ;
        ForeColor = Rgb(0,0,255), ;
        ZOrderSet = 12, ;
        Name = "Command16"

    Add Object command17 As CommandButton With ;
        Top = 6, ;
        Left = 300, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontSize = 8, ;
        Caption = "Ss", ;
        MousePointer = 5, ;
        ToolTipText = "SuperScript", ;
        ForeColor = Rgb(0,0,255), ;
        ZOrderSet = 12, ;
        Name = "Command17"

    Add Object check3 As Checkbox With ;
        Top = 6, ;
        Left = 326, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontSize = 10, ;
        Alignment = 0, ;
        Caption = "Bu", ;
        Value = 0, ;
        MousePointer = 15, ;
        Style = 1, ;
        ToolTipText = "Bullet indent", ;
        ForeColor = Rgb(128,0,64), ;
        Name = "Check3"

    Add Object command18 As CommandButton With ;
        Top = 36, ;
        Left = 211, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontItalic = .T., ;
        FontSize = 10, ;
        Picture = Home(4)+"BITMAPS\TLBR_W95\lft.bmp", ;
        Caption = "", ;
        MousePointer = 15, ;
        ToolTipText = "Algn left", ;
        ForeColor = Rgb(0,0,255), ;
        ZOrderSet = 12, ;
        Name = "Command18"

    Add Object command19 As CommandButton With ;
        Top = 36, ;
        Left = 235, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontItalic = .T., ;
        FontSize = 10, ;
        Picture = Home(4)+"BITMAPS\TLBR_W95\ctr.bmp", ;
        Caption = "", ;
        MousePointer = 15, ;
        ToolTipText = "Align center", ;
        ForeColor = Rgb(0,0,255), ;
        ZOrderSet = 12, ;
        Name = "Command19"

    Add Object command20 As CommandButton With ;
        Top = 36, ;
        Left = 259, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontItalic = .T., ;
        FontSize = 10, ;
        Picture = Home(4)+"BITMAPS\TLBR_W95\rt.bmp", ;
        Caption = "", ;
        MousePointer = 15, ;
        ToolTipText = "Align right", ;
        ForeColor = Rgb(0,0,255), ;
        ZOrderSet = 12, ;
        Name = "Command20"

    Add Object command21 As CommandButton With ;
        Top = 36, ;
        Left = 283, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontItalic = .T., ;
        FontSize = 10, ;
        Picture =Home(4)+"BITMAPS\TLBR_W95\jst.bmp", ;
        Caption = "", ;
        MousePointer = 15, ;
        ToolTipText = "Justified", ;
        ForeColor = Rgb(0,0,255), ;
        ZOrderSet = 12, ;
        Name = "Command21"

    Add Object command22 As CommandButton With ;
        Top = 36, ;
        Left = 308, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontSize = 8, ;
        Picture = Home(4)+"BITMAPS\TLBR_W95\jst.bmp", ;
        Caption = "Dis", ;
        MousePointer = 15, ;
        ToolTipText = "Distribued", ;
        ZOrderSet = 12, ;
        Name = "Command22"

    Add Object command23 As CommandButton With ;
        Top = 66, ;
        Left = 397, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontItalic = .T., ;
        FontSize = 10, ;
        Picture = Home(4)+"BITMAPS\OFFCTLBR\SMALL\COLOR\undo.bmp", ;
        Caption = "", ;
        MousePointer = 15, ;
        ToolTipText = "Unddo", ;
        ForeColor = Rgb(0,0,255), ;
        ZOrderSet = 12, ;
        Name = "Command23"

    Add Object command24 As CommandButton With ;
        Top = 66, ;
        Left = 422, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontItalic = .T., ;
        FontSize = 10, ;
        Picture =Home(4)+"BITMAPS\OFFCTLBR\SMALL\COLOR\redo.bmp", ;
        Caption = "", ;
        MousePointer = 15, ;
        ToolTipText = "Redo", ;
        ForeColor = Rgb(0,0,255), ;
        ZOrderSet = 12, ;
        Name = "Command24"


    Add Object command25 As CommandButton With ;
        Top = 66, ;
        Left = 472, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontItalic = .T., ;
        FontSize = 10, ;
        Picture = Home(4)+"BITMAPS\OFFCTLBR\SMALL\COLOR\copy.bmp", ;
        Caption = "", ;
        MousePointer = 15, ;
        ToolTipText = "Copy", ;
        ForeColor = Rgb(0,0,255), ;
        ZOrderSet = 12, ;
        Name = "Command25"

    Add Object command26 As CommandButton With ;
        Top = 66, ;
        Left = 498, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontItalic = .T., ;
        FontSize = 10, ;
        Picture = Home(4)+"BITMAPS\OFFCTLBR\SMALL\COLOR\paste.bmp", ;
        Caption = "", ;
        MousePointer = 15, ;
        ToolTipText = "Pase", ;
        ForeColor = Rgb(0,0,255), ;
        ZOrderSet = 12, ;
        Name = "Command26"

    Add Object command27 As CommandButton With ;
        Top = 66, ;
        Left = 446, ;
        Height = 25, ;
        Width = 25, ;
        FontBold = .T., ;
        FontItalic = .T., ;
        FontSize = 10, ;
        Picture = Home(4)+"BITMAPS\OFFCTLBR\SMALL\COLOR\cut.bmp", ;
        Caption = "", ;
        MousePointer = 15, ;
        ToolTipText = "Cut", ;
        ForeColor = Rgb(0,0,255), ;
        ZOrderSet = 12, ;
        Name = "Command27"

    Add Object command28 As CommandButton With ;
        Top = 66, ;
        Left = 522, ;
        Height = 28, ;
        Width = 50, ;
        FontBold = .T., ;
        FontSize = 8, ;
        Caption = "SelectA", ;
        MousePointer = 15, ;
        ToolTipText = "Select all oleRTF", ;
        Name = "Command28"

    Add Object command29 As CommandButton With ;
        Top = 66, ;
        Left = 571, ;
        Height = 25, ;
        Width = 38, ;
        FontBold = .T., ;
        FontSize = 8, ;
        Caption = "Home", ;
        MousePointer = 15, ;
        ToolTipText = "Copy", ;
        ZOrderSet = 12, ;
        Name = "Command29"

    Add Object command30 As CommandButton With ;
        Top = 66, ;
        Left = 607, ;
        Height = 25, ;
        Width = 32, ;
        FontBold = .T., ;
        FontSize = 8, ;
        Caption = "End", ;
        MousePointer = 15, ;
        ToolTipText = "Copy", ;
        ZOrderSet = 12, ;
        Name = "Command30"

    Add Object shape1 As Shape With ;
        Top = 42, ;
        Left = 342, ;
        Height = 13, ;
        Width = 13, ;
        BackColor = Rgb(0,255,0), ;
        Name = "Shape1"

    Add Object shape2 As Shape With ;
        Top = 42, ;
        Left = 356, ;
        Height = 13, ;
        Width = 13, ;
        BackColor = Rgb(255,0,0), ;
        Name = "Shape2"


    Add Object shape3 As Shape With ;
        Top = 42, ;
        Left = 370, ;
        Height = 13, ;
        Width = 13, ;
        BackColor = Rgb(255,255,255), ;
        Name = "Shape3"

    Add Object shape4 As Shape With ;
        Top = 42, ;
        Left = 384, ;
        Height = 13, ;
        Width = 13, ;
        BackColor = Rgb(0,0,255), ;
        Name = "Shape4"


    Add Object shape5 As Shape With ;
        Top = 42, ;
        Left = 399, ;
        Height = 13, ;
        Width = 13, ;
        BackColor = Rgb(128,0,64), ;
        Name = "Shape5"


    Add Object shape6 As Shape With ;
        Top = 42, ;
        Left = 415, ;
        Height = 13, ;
        Width = 13, ;
        BackColor = Rgb(255,128,0), ;
        Name = "Shape6"

    Add Object shape7 As Shape With ;
        Top = 42, ;
        Left = 429, ;
        Height = 13, ;
        Width = 13, ;
        BackColor = Rgb(255,255,0), ;
        Name = "Shape7"

    Add Object shape8 As Shape With ;
        Top = 42, ;
        Left = 443, ;
        Height = 13, ;
        Width = 13, ;
        BackColor = Rgb(128,0,128), ;
        Name = "Shape8"

    Add Object shape9 As Shape With ;
        Top = 42, ;
        Left = 457, ;
        Height = 13, ;
        Width = 13, ;
        BackColor = Rgb(0,255,255), ;
        Name = "Shape9"


    Add Object shape10 As Shape With ;
        Top = 42, ;
        Left = 472, ;
        Height = 13, ;
        Width = 13, ;
        BackColor = Rgb(0,0,0), ;
        Name = "Shape10"


    Procedure filllist
        Lparameters cFontName

        Thisform.cbofontsize1.Clear

        Dimension aSizes[1]
        =Afont(aSizes, cFontName)
        If aSizes[1] = -1  && The font is scalable
            lScalable = .T.
            nLen = Thisform.nlargestfont
            nStart = Thisform.nsmallestfont
        Else
            nLen = Alen(aSizes)
            nStart = 1
            lScalable = .F.
        Endif

        If lScalable
            For i = nStart To nLen
                Thisform.cbofontsize1.AddItem(Alltrim(Str(i)))
            Endfor
        Else
            For i = nStart To nLen
                Thisform.cbofontsize1.AddItem(Alltrim(Str(aSizes[i])))
            Endfor
        Endif
    Endproc


    Procedure Load
        *Use yrtf  Alias yrtf
        This.ctext = yrtf.Source
    Endproc


    Procedure Init
        Publi m.xold
        * Check to see if OCX installed and loaded.
        If Type("THIS.oleRTF") # "O" Or Isnull(This.olertf)
            Return .F.
        Endif
        *******************************************
        Thisform.olertf.ControlSource = "yrtf.source"  &&important
        ********************************************
        
        If  Fontmetric(1, 'MS Sans Serif', 8, '') # 13 Or ;
                fontmetric(4, 'MS Sans Serif', 8, '') # 2 Or ;
                fontmetric(6, 'MS Sans Serif', 8, '') # 5 Or ;
                fontmetric(7, 'MS Sans Serif', 8, '') # 11
            This.SetAll('fontname', 'Tahoma')
        Else
            This.SetAll('fontname','MS Sans Serif')
        Endif
        This.SetAll('fontsize',8)
        This.SetAll("mousepointer",15,"commandbutton")
        This.SetAll("backcolor",Rgb(196,255,196),"commandbutton")
        This.command1.BackColor=255

        This.nstripsize = This.olertf.Top
        This.olertf.Width = This.Width
        This.olertf.Height = This.Height - This.nstripsize

        This.cbofontname1.Value = This.olertf.Font.Name
        Thisform.filllist(This.olertf.Font.Name)
        This.cbofontsize1.Value = Alltrim(Str(This.olertf.Font.Size))
        This.olertf.AutoVerbMenu=.F.
        With Thisform
            For i=1 To .ControlCount
                If !Lower(.Controls(i).Class)=="olecontrol"
                    Try
                        .Controls(i).Anchor=768
                    Catch
                    Endtry
                Else
                    .Controls(i).Anchor=15
                Endi
            Endfor
        Endwith

        Try
            Resto From  ybk.mem AddI
            This.olertf.BackColor=m.xcolor
        Catch    &&ybk.mem dont exists(at first starting)
            Local m.xcolor
            m.xcolor=This.olertf.BackColor
            Save  To ybk.mem  All Like xcolor*
        Endtry
        *restore form background image
        local m.mypic
text to m.mypic noshow        
/9j/4AAQSkZJRgABAQEAYABgAAD/4QAiRXhpZgAATU0AKgAAAAgAAQESAAMAAAABAAEAAAAAAAD/2wBDAAIBAQEBAQIBAQECAgICAgQDAgICAgUEBAMEBgUGBgYFBgYGBwkIBgcJBwYGCAsICQoKCgoKBggLDAsKDAkKCgr/2wBDAQICAgICAgUDAwUKBwYHCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgr/wAARCABcAGIDASIAAhEBAxEB/8QAHwAAAQUBAQEBAQEAAAAAAAAAAAECAwQFBgcICQoL/8QAtRAAAgEDAwIEAwUFBAQAAAF9AQIDAAQRBRIhMUEGE1FhByJxFDKBkaEII0KxwRVS0fAkM2JyggkKFhcYGRolJicoKSo0NTY3ODk6Q0RFRkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqDhIWGh4iJipKTlJWWl5iZmqKjpKWmp6ipqrKztLW2t7i5usLDxMXGx8jJytLT1NXW19jZ2uHi4+Tl5ufo6erx8vP09fb3+Pn6/8QAHwEAAwEBAQEBAQEBAQAAAAAAAAECAwQFBgcICQoL/8QAtREAAgECBAQDBAcFBAQAAQJ3AAECAxEEBSExBhJBUQdhcRMiMoEIFEKRobHBCSMzUvAVYnLRChYkNOEl8RcYGRomJygpKjU2Nzg5OkNERUZHSElKU1RVVldYWVpjZGVmZ2hpanN0dXZ3eHl6goOEhYaHiImKkpOUlZaXmJmaoqOkpaanqKmqsrO0tba3uLm6wsPExcbHyMnK0tPU1dbX2Nna4uPk5ebn6Onq8vP09fb3+Pn6/9oADAMBAAIRAxEAPwD9mNY/daNcT/8AXKpNYhM2g2+q/wDPLzaPG0Is/DEcH/LS61KLyf8AtlVzXZv+JPp/hyCD/j6hluJq+DPYM/TfPNpH/wBNf9dVyGGD+0P+mlHguKzhhkvta/1dhDLJN/2yqnDeT6jdefBB5cd1/qYv+eVABeSw6lqn9qQf6yL93N/1yqTUryD7LHYz/wDPbzKuXmm6V4btvI+2xyXEv+ui/wCeVZfjCEQ6NZzwH95LqUUdAGhq+sQXmjR2P/TbzKz7zWILPRrfyIP3n/LGrF5Z+dYR+T/rIpqp+JLOCbxHZ6VB+88mHzJqmoBc8K/bodZk1W+n/eSwxVTmhgvPFvkWPmeXLN++rYvNNn021jnn/dVF4dsrPR7m88X6mcW9jDLJ5f8Az0qgJf7N8nWbiD/nlVOz8i8luJ/9ZJVfUbvVdXlt5pp/K+1TeZNDR4bs54b/AMQWP+s+yzf+0qzAYnn7F29McUVWFxuGcUVoBoWem315LHY337z7L/qfNqvd6kdR8eSQWQ8y30uzitvO/wCmv+tlqTUtSnm16SCxn8u3lh8v9zVfw3psGmxXH/PSWbzJqzAPEl5qs1rJ4c0OD95qk0Uc03/TL/lrWh5N9ptrHBD/AKyL/ntViymghuo5/wDnlVfxJqRhv4/+m01AFPTNMvbLwvrHiLxFN5lxL5sk0s3/AD1/5ZVHrE082jeH/P8A+gx/7Sq14vNxerpHgGxxi5ll1HUv+ucX+r/8i4/79U7xHF/xItPng/5Zax/7SoAsXkPneZB5/wD35qPw34bg0HVP337ySWb99NNUnfz/APlnUniq8+xy299/yz/dVoZe8Y8M2q69rOoarfTyfuryWOGH/nlFFR4l8UT6lpsfhDQ9Lk8y6mi+2XU3+qiij/5ZVcs4YLPxReWOf3cv+k/9sqk/cQyyf89KzRqWJrOCz0a3vp/+fzy6j+Hvn/2D4gnn/wCPiXUpZJqi8XXjHX9I8Hw/8usX2jUP+usv+qiqz4bP9m3/AIk0r/nrNFJ/39irT/l6Y/8ALs4G61C8F1IFPHmNj86KsXDo07sp/jP86KzNjsvDlnBqMVxfX3l+XHD5k3nVX028g1K6knsYJPLl/wBTNWPps2q+JIv7K/5h/wDy28n/AJa10k3kaD4djvv9X/pkUcNAFjWLTSvDlrHBPfR/aPJ8yGH/AJa1h6xD/bEtnPB+8jlmiqOKD7Z4sk1W+/eeb/qfO/55VsaDZ2MOqeT50flxTeZVfxQJNM8geMfFGuTj/j1hisof+uUUXm/+1ax9NvP7S8EW88//AC117y4asDUf+Ki8SW8H/LSbzP8AyFUnhuyH/CJW9lP/AMuupeZUgWNd1iCz8vw5Y2MfmeT5k003/LKsvxJqQ1L4fR32f3n/ADx/6a1Hpnn6v431jXP+WcU3lw/9coqkvNN/1mk/8s5ZvMh/z/n/AFtAFi7M8XinSP8AnpJoXmTf9/f3VWrC40vR7G88a+J5/wDRLb/yJJ/zzjp15Z2I1O31W9vY7a3i03y5ppZv9VFFWTb2f/CzL/8AtxopI/Duj/u9HhmPl/apf+fqT/2lQIb4NstT1a+k8RapB/pms3nmTQ/88ov+WUX/AGyiq+J4Z/Fnii5gn/dx+Vb/APbWKL95VvStYhs4dU8UDyvs+m2ssn/bT/lnWT4Q0HVJNA+xE+ZcXU3mzTf9NZaAMFNG0/YPO+9j5vrRXrVt4L8PxW8cUqfMqAN9cUU7C5kef+CZ/sfheSecfvIqueJIptZ/4Rfw5b/8vM0t7N/1yi/df+1az4fIh8L3H/TWtTSLu3i8R+H70j93Ho8vk/8AXXzaf9wor6xZwWcX9qwf6y1m/ff9cquQ6bB5tvPP+783/UzVlzXtxqVh4s8//VxWf/kWtTxfeQ6bYaP5M0n/ACy86pAp3cP2PXrieD/nt5c1bFn5Fn4cvJ/+WcUNU7yEzeI9Ugn/ANXLN+5/79Vl+JNWtzpFv4CsZvM1HVLyLzov+eUUf/PSq/hAGj5s7q4g/wCWd1+8hrQ1iKaHRrPVf+WkU3lzf9cqj/s2Cz8sT/8ALKrl5r9jqWjeRBB/2xqQKesabBrFrHBOfMjqTxJrAs/C8fhzQ/8AWf8ALGKGiHWNKm8uD/V+V/z2put+NvCPha2+2af5erav/wAuun2n/PX/AKaf88o6AKGowm0trP4W2X7y4/dXGuy/+0v/AGrV/wASa74hTVI/AHgmb7F9ls4pNY1CGH95F5v+qijpnh/w1L4TtLe81mbzL/UpvtGo3Un/AC0kkqzpssFndeLNVn/4+JLz/Xf9MvKioJMhfCMUih21fUXLDJZure9FYaeLG2jcOcc0VoR7x0+pabB5sljBP+7l8qrGpWf/ABK7eaD/AJcJv/IVF5D+6jvp/wDllNVf9/DrMmlXE/8Ayx8yH/rlWZqWLPTYJrW4g/5+ofLqnNZ3GpWtn9o/1lr+7mqT9/Z6h/0zlqxN9u839xQAaxezm1kvvs/7zyf31HgnR9Ks4pPGM8HmSSw/uZqk02aC8i/0j/lr+7rPtLPVbzS4/CtjBJ5kU3l/9sqAJLPUp9S1SSf/AJZ1Yhs7c/uP+etNe48LeHorjwvpUslxqUUP+leTF/q5P+eXm/8APWpvtkE2jR6rB/q5aAM/yf8AmEzf89q6Dw34P8OaP5d95EfmVj+JPPs7/R9Vg/5epvLqTWNS1Wa7jgggk8uKgCP4p+KfN1mzFv8A89oqj1jz4de1Sxg/5eoYpKw9Y02+1jWbMzwf6qaKu41KzsYfFvn30/lx2umxedVfxSf4Jz0Hw9vWgRj3Ufyordb4wWanbFo2FH3fpRWwzHvJp5tGuIJ6Jpj/AGho99P/AM+csc3/AF1p0ygX13D/AAt5WRUl0oaxKn/lj/q/aucY6b/S7WSDyP3kU1Gj3k/+on/1kX7uapFkZofPP3qq3mLeVHiGNvSgB32T7HqkkEH+rl/eQ0azqOt6fYST+HZo47i6/dfavJ/eRf8AXOrUqibyGl+Yr0zVjVow9luYn/d7VoBm+CdB0vR4o7GD/lrDL53nf62WWqemwz3mg2+hwQfvPOljm/7+1rQMYZN6Vb8LOlit9qMVvGWVfPVWX5Q/riswMnxQJ9S8ZW+i2X/HnocXl/8AXWWX/WVs3uow+G9Ns7KDS47m81Sby/33/LOKuf8ACWLqKbUblRJNcXVzNIzDq7dTXTaggufEGmlvl8mGXZt4rQx1MXQZoLzWZIJ4P3lrN5c1SXYn1e58QTT/APLSaX/v1FWP4CuJbvUtRvZT882oSs+3pmug1eV7bTNeER6RhR9G61n/AMuTYp6fp8E1hBN/ehU/pRWLD8sSqD0UUUAf/9k=
endtext
strtofile(strconv(m.mypic,14), "fonds.jpg")
thisform.picture="fonds.jpg"
    Endproc

    Procedure Resize
        This.olertf.RightMargin = This.olertf.Width-10
    Endproc

    Procedure Destroy
        Close Data All
        Clea Events
    Endproc

    Procedure olertf.Init
        This.Object.RightMargin = This.Width - 10
    Endproc

    Procedure olertf.GotFocus
        On Key Label F1 Help Id _Screen.ActiveForm.HelpContextID
    Endproc

    Procedure olertf.LostFocus
        On Key Label F1
    Endproc

    Procedure command3.Click
        Set Date French
        Set Century On
        Local m.x,m.xfontsize,m.xcolor
        m.x=+Chr(13)+Chr(10)+Cdow(Date())+"  "+Ttoc(Datetime())+Chr(13)+Chr(10)
        m.xfontsize=Thisform.olertf.SelFontSize
        Thisform.olertf.SelFontSize=14
        Thisform.olertf.SelColor =255
        Thisform.olertf.Selbold=.T.
        Thisform.olertf.SelText=Thisform.olertf.SelText+m.x
        Thisform.olertf.SelFontSize=m.xfontsize
        Thisform.olertf.Selbold=.F.
        Thisform.olertf.SelColor =0
    Endproc

    Procedure command2.Click
        Local m.xline
        Thisform.olertf.Selbold=.F.
        Thisform.olertf.SelFontSize=9
        Thisform.olertf.SelColor=255
        m.xline=Chr(13)+Chr(10)+Repli("_",110*Thisform.olertf.Width/805)+Chr(13)+Chr(10)
        Thisform.olertf.SelText=Thisform.olertf.SelText+m.xline
        Thisform.olertf.SelColor=0
    Endproc

    Procedure command1.Click
        Thisform.Release
    Endproc

    Procedure command4.Click
        Local m.xcolor
        m.xcolor=Getcolor()
        If !m.xcolor=-1
            Thisform.olertf.BackColor=m.xcolor
            Save  To ybk.mem  All Like xcolor*
        Endi
    Endproc

    Procedure spnrightmargin.InteractiveChange
        This.SetFocus()    && Needed to let the RTF control know a change has been made.
        && Unfortunately, this breaks keyboard entry... If you delete it,
        && they both take effect when you exit this control.
    Endproc

    Procedure command5.Click
        *You can control the printing of an RTF file or RTF source kept in a memo using RTF
        *activex + CommonDialog activex. Set the flag property of CommonDialog to 0x100 and ShowPrinter. ie:
        Try
        Thisform.AddObject("ComDlg","OleControl","mscomdlg.commondialog" )
        Catch
        Endtry
        If Vartype(Thisform.Comdlg)="O"
            With Thisform.Comdlg
                .Flags=0x100
                .ShowPrinter()
                Thisform.olertf.SelPrint(.hdc)
            Endwith
        Endi
    Endproc

    Procedure spnindent.InteractiveChange
        This.SetFocus()    && Needed to let the RTF control know a change has been made.
        && Unfortunately, this breaks keyboard entry... If you delete it,
        && they both take effect when you exit this control.
    Endproc

    Procedure vcr1.recordpointermoved
        DoDefault()
        Thisform.ctext = yrtf.Source
        If Deleted()
            Thisform.label1.Caption=Trans(Recno())+"/"+Trans(Reccount())+" Pages "+"(Del.)"
        Else
            Thisform.label1.Caption=Trans(Recno())+"/"+Trans(Reccount())+" Pages"
        Endi
        vcr::recordpointermoved
    Endproc

    Procedure vcr1.beforerecordpointermoved
        DoDefault()
        Replace yrtf.Source With Thisform.olertf.TextRTF
        vcr::beforerecordpointermoved
    Endproc

    Procedure vcr1.Init
        DoDefault()
        Try
            If Deleted()
                Thisform.label1.Caption=Trans(Recno())+"/"+Trans(Reccount())+" Pages "+"(Del.)"
            Else
                Thisform.label1.Caption=Trans(Recno())+"/"+Trans(Reccount())+" Pages"
            Endi
        Catch
        Endtry
    Endproc

    Procedure cmdnew.Click
        Replace yrtf.Source With Thisform.olertf.TextRTF
        Append Blank
        Thisform.ctext = yrtf.Source
        This.Parent.vcr1.EnableDisableButtons
        Thisform.label1.Caption=Trans(Recno())+"/"+Trans(Reccount())+" Pages"
        Thisform.Refresh
    Endproc

    Procedure command7.Click
        Local m.myvar
        TEXT TO m.myvar noshow
This is a table embedding multi richtextbox texts .
The RTF texts are stored in the table yrtf.dbf , in memo fileds.
Can navig in the records of this table by the VCR class in the container above.
(this save directly any modification in the table yrtf.dbf)
Can do all operations of RTF box ( embed as olecontrol on the form).
Added controls to achieve that with codes.can test each one.
Can protect the rtfbox to dont modify(see checkbox).
For unicode type the text in a txt file saved as UTF-8. Load it as txt file from the toolbar (open RTF).
adjust the fontsize,right alignment...You can also put the text i a string encoded as strconv(..,13) and
reuse it as decoded  strconv(..,14).

The OleRTF.backcolor property is stored in ybk.mem and can be restored.

Warning: this record only texts ,and small images .....big images can produce some problems icreasing capacities
of the fpt file and slowing the form.

 Author: Yousfi Benameur  El Bayadh Algeria
            11 january 2013
        ENDTEXT
        Messagebox(m.myvar,0+32+4096,"yRTF")
    Endproc

    Procedure command9.Click
        Local lcSearch,lnPos,lcnumber
        Do Case
            Case This.Caption="Search Highlight"
                This.Caption="Recolor"
                lcSearch = Inputbox("Text to search for","","")
                If Empty(m.lcSearch)
                    Return .F.
                Endi
                m.xold= Thisform.olertf.TextRTF
                *thisform.ysearch=allt(m.lcSearch)
                lcReplace= m.lcSearch
                lcnumber=0
                With Thisform.olertf
                    lnPos = .Find(m.lcSearch)
                    lnFirst = m.lnPos
                    Do While m.lnPos > -1
                        .SelColor = Rgb(255,0,0) && color it red
                        .SelText = m.lcReplace
                        lnPos = .Find(m.lcSearch,m.lnPos + Len(m.lcSearch))
                        lcnumber=lcnumber+1
                    Enddo
                    .SelStart = 0 && Len(m.tcText)
                    .SelStart = m.lnFirst && Locate before first one
                    Messagebox(Trans(lcnumber)+" occurences found!",0+32+4096,"Search highlight")
                Endwith
        
            Case This.Caption="Recolor"
                This.Caption="Search Highlight"
                Repl yrtf.Source With m.xold
                Thisform.olertf.TextRTF= yrtf.Source
        Endcase
    Endproc

    Procedure command8.Click
        Local lcSearch,lcReplace,lnPos,lcnumber
        lcnumber=0
        lcSearch = Inputbox("Searching for :","","")
        lcReplace= Inputbox("Replace with ;","","")
        If Empty(m.lcSearch) Or Empty(m.lcReplace)
            Return .F.
        Endi

        With Thisform.olertf
            lnPos = .Find(m.lcSearch)
            lnFirst = m.lnPos
            Do While m.lnPos > -1
                .SelColor = Rgb(255,0,0) && color it red
                .SelText = m.lcReplace
                lcnumber=lcnumber+1
                lnPos = .Find(m.lcSearch,m.lnPos + Len(m.lcSearch))
            Enddo
            .SelStart = 0 && Len(m.tcText)
            .SelStart = m.lnFirst && Locate before first one
        Endwith

        Messagebox(Trans(lcnumber)+ " replaced occurences",0+32+4096,"Search Replace")
    Endproc

    Procedure command10.Click
        Local loComDialog
        loComDialog = Createobject("mscomdlg.commondialog")
        loComDialog.Filter = "All Files (*.*)|*.*|RTF files |*.RTF|txt files|*.txt"
        loComDialog.MaxFileSize=60
        loComDialog.ShowSave()
        Local m.oo
        m.oo=.F.
        Do Case
            Case Lower(Justext(loComDialog.FileName))="rtf"
                =Thisform.olertf.savefile(loComDialog.FileName,0)
                m.oo=.T.
            Case Lower(Justext(loComDialog.FileName))="txt"
                =Thisform.olertf.savefile(loComDialog.FileName,1)
                m.oo=.T.
            Otherwise
                m.oo=.F.
        Endcase

        If m.oo=.T.
            Messagebox("Saved as :"+loComDialog.FileName,0+32+4096,"Save",1500)
        Endi

        loComDialog=Null
        Release loComDialog
    Endproc

    Procedure command11.Click
        
        Local lcfilename
        lcfilename=Getfile("rtf|txt")
        If Empty(m.lcfilename) Or ! Inlist(Lower(Justext(m.lcfilename)),"rtf","txt")
            Return .F.
        Endi
        Do Case
            Case Lower(Justext(m.lcfilename))=="rtf"
                Thisform.olertf.loadfile(m.lcfilename,0)
            Case Lower(Justext(m.lcfilename))=="txt"
                Thisform.olertf.loadfile(m.lcfilename,1)
        Endcase

        Append Blank
        Replace yrtf.Source With Thisform.olertf.TextRTF
        Go Botto
        Thisform.ctext = yrtf.Source
        This.Parent.vcr1.EnableDisableButtons
        Thisform.label1.Caption=Trans(Recno())+"/"+Trans(Reccount())+" Pages"
        Thisform.Refresh
        Retu
    Endproc

    Procedure command12.Click
        Sele yrtf
        Dele
        Thisform.label1.Caption=Trans(Recno())+"/"+Trans(Reccount())+" Pages "+"(Del.)"
        Messagebox("this page is marked for deleting late!",0+32+4096,"delete",1500)
    Endproc

    Procedure label2.Click
        Try
            Run/N charmap.Exe
        Catch
            Messagebox("Charmap.exe is missed on system!",16+4096,"Error")
        Endtry
    Endproc

    Procedure command13.Click
        Sele yrtf
        Append Blank
        *for an exist unicode text file saved as utf8
        *m.ystr=Strconv(Filetostr("yarabic.txt"),13 &&5,178,2)  &&11 Converts UTF-8 characters in cExpression to double-byte characters.
        
        *this is for arabic text demo ciped with strconv(..,13)
        local m.ystr
        text to m.ystr noshow
        77u/2LPZitis2LHZiiDZhdiv2LHZkdioINin2YTZhdmG2KrYrtioINin2YTZiNi32YbZitiMINmI2K3ZitivINit2KfZhNmK2YTZiNiy2YrYqti02Iwg2KzZiNmE2Kkg2LnYqNixINin2YTZhdmE2KfYudioINin2YTYo9mI2LHZiNio2YrYqSDZhNmF2LnYp9mK2YbYqSDYp9mE2YTYp9mR2LnYqNmK2YYg2KfZhNis2LLYp9im2LHZitmK2YbYjCDZgtio2YQg2KPZhiDZiti52YjYryDYpdmE2Ykg2KfZhNis2LLYp9im2LEg2YbZh9in2YrYqSDYp9mE2LTZh9ixINin2YTYrNin2LHZiiDZhNmF2YjYp9i12YTYqSDYudmF2YTZhyDYqNis2KfZhtioINmF2LPYp9i52K/ZitmHINin2YTYsNmK2YYg2KfZhNiq2K3ZgtmI2KfYjCDYo9mI2YQg2KPZhdiz2Iwg2KjYp9mE2YXYsdmD2LIg2KfZhNiq2YLZhtmKINio2LPZitiv2Yog2YXZiNiz2Ykg2YTZhdmI2KfYtdmE2Kkg2KfZhNi52YXZhCDYqtit2LbZitix2Kcg2YTZhdmI2YbYr9mK2KfZhCDYp9mE2KjYsdin2LLZitmELg0KINi32YTYqCDYp9mE2YXYr9ix2ZHYqCDYp9mE2YjYt9mG2Yog2YjYrdmK2K8g2K3Yp9mE2YrZhNmI2LLZitiq2LQg2YXZhiDZiNmE2YrYryDYtdin2K/ZitiMINin2YTZhdmG2KfYrNmK2LEg2KfZhNi52KfZhSDZhNmE2YXZhtiq2K7YqCDYp9mE2YjYt9mG2YrYjCDYp9mE2YXZiNin2YHZgtipINi52YTZiSDYqtij2K7YsdmHINmB2Yog2KfZhNi52YjYr9ipINil2YTZiSDYp9mE2KzYstin2KbYsdiMINmD2YjZhtmHINin2LbYt9ixINmE2YTYqtmG2YLZhCDYpdmE2Ykg2KfZhNio2YjYs9mG2Kkg2YXZhiDYo9is2YQg2LLZitin2LHYqSDZiNin2YTYryDYstmI2KzYqtmHINin2YTYsNmKINmK2KrZiNin2KzYryDZgdmKINit2KfZhNipINi12K3ZitipINit2LHYrNipINmE2YTYutin2YrYqdiMINit2YrYqyDYs9mK2LnZiNivINin2YTZhdiv2LHZkdioINin2YTZiNi32YbZiiDZhtmH2KfZitipINin2YTYtNmH2LEg2KfZhNis2KfYsdmK2Iwg2KjYudiv2YXYpyDZitis2LHZiiDYrNmI2YTYqSDYudio2LEg2KfZhNmF2YTYp9i52Kgg2KfZhNij2YjYsdmI2KjZitipINmE2YXYudin2YrZhtipINi52K/YryDZhdmGINin2YTZhNin2ZHYudio2YrZhtiMINio2YrZhtmF2Kcg2LnYp9ivINmF2LPYp9i52K/ZiCDYp9mE2YXYr9ix2ZHYqCDYp9mE2YjYt9mG2Yog2KPZhdizINil2YTZiSDYp9mE2KzYstin2KbYsdiMINmI2KjYp9i02LHZiNinINi52YXZhNmH2YUg2YTYqtit2LbZitixIOKAnNin2YTYrti22LHigJ0g2YTZhdmI2LnYryDZhdmI2YbYr9mK2KfZhCDYp9mE2KjYsdin2LLZitmELg0K2KPYs9mF2KfYoSDYrNiv2YrYr9ipINmB2Yog2YXZgdmD2ZHYsdipINin2YTZhdiv2LHZkdioINin2YTZiNi32YbZig0KDQou
        endtext
            
        Thisform.olertf.TextRTF=Strconv(m.ystr,14)
        Replace yrtf.Source With Thisform.olertf.TextRTF
        Go Botto
        Thisform.ctext = yrtf.Source
        This.Parent.vcr1.EnableDisableButtons
        Thisform.label1.Caption=Trans(Recno())+"/"+Trans(Reccount())+" Pages"
        Thisform.Refresh
    Endproc

    Procedure check1.Init
        This.Value=0
    Endproc

    Procedure check1.Click
        Thisform.olertf.AutoVerbMenu=Iif(This.Value=0,.F.,.T.)
        Thisform.Refresh
    Endproc

    Procedure check2.InteractiveChange
        Thisform.olertf.selProtected=!Thisform.olertf.selProtected
    Endproc

    Procedure check2.Init
        This.Value=0
    Endproc

    Procedure spinner1.InteractiveChange
        Do Case
            Case This.Value=1
                With Thisform
                    .SetAll("backcolor",Rgb(0,255,0),"commandbutton")
                    Local m.xcolor
                    m.xcolor=Rgb(224,224,224  )
                    .olertf.BackColor=m.xcolor
                    Save  To ybk.mem  All Like xcolor*
                Endwith

            Case This.Value=2
                With Thisform
                    .SetAll("backcolor",Rgb(196,255,196),"commandbutton")
                    Local m.xcolor
                    m.xcolor=Rgb(255,222,206 )
                    .olertf.BackColor=m.xcolor
                    Save  To ybk.mem  All Like xcolor*
                Endwith


            Case This.Value=3
                With Thisform
                    .SetAll("backcolor",Rgb(160,149,239),"commandbutton")
                    Local m.xcolor
                    m.xcolor=Rgb(255,202,228 )
                    .olertf.BackColor=m.xcolor
                    Save  To ybk.mem  All Like xcolor*
                Endwith

            Case This.Value=4
                With Thisform
                    .SetAll("backcolor",Rgb(119,255,187),"commandbutton")
                    Local m.xcolor
                    m.xcolor=Rgb(239,223,255 )
                    .olertf.BackColor=m.xcolor
                    Save  To ybk.mem  All Like xcolor*
                Endwith

            Case This.Value=5
                With Thisform
                    .SetAll("backcolor",Rgb(196,255,255 ),"commandbutton")
                    Local m.xcolor
                    m.xcolor=Rgb(187,187,225 )
                    .olertf.BackColor=m.xcolor
                    Save  To ybk.mem  All Like xcolor*
                Endwith
        Endcase
    Endproc

    Procedure cbofontname1.Init
        With This
            Dimension x[1]
            =Afont(x)
            For i = 1 To Alen(x)
                .AddItem(x[i])
            Endfor

            .Style=2
            .ListIndex=1
        Endwith
    Endproc

    Procedure cbofontname1.Click
        Thisform.filllist(This.Value)
        Thisform.olertf.SelFontName = This.Value
    Endproc

    Procedure cbofontsize1.Click
        Thisform.olertf.SelFontSize = Val(This.Value)
    Endproc

    Procedure cmdbold.Click
        Thisform.olertf.Selbold = !Thisform.olertf.Selbold
    Endproc

    Procedure command6.Click
        Thisform.olertf.SelItalic = !Thisform.olertf.SelItalic
    Endproc

    Procedure command14.Click
        Thisform.olertf.SelColor = Getcolor()
    Endproc

    Procedure command15.Click
        Thisform.olertf.SelUnderline = !Thisform.olertf.SelUnderline
    Endproc

    Procedure command16.Click
        *subscript
        Thisform.olertf.Object.SelCharOffset = Iif(Thisform.olertf.Object.SelCharOffset < 0, 0,  -100)
    Endproc

    Procedure command17.Click
        *superscript
        Thisform.olertf.Object.SelCharOffset = Iif(Thisform.olertf.Object.SelCharOffset > 0, 0,  100)
    Endproc

    Procedure check3.Click
        *bullet
        With Thisform.olertf.Object
            .BulletIndent = 15
            .SelBullet = This.Value
        Endwith
    Endproc

    Procedure command18.Click
        Local oo
        oo=Thisform.olertf
        With oo
            .SetFocus
            .Object.SelAlignment=0  &&left
            .Refresh
        Endwith
    Endproc

    Procedure command19.Click
        Local oo
        oo=Thisform.olertf
        With oo
            .SetFocus
            .Object.SelAlignment=2  &&center
            .Refresh
        Endwith
    Endproc

    Procedure command20.Click
        Local oo
        oo=Thisform.olertf
        With oo
            .SetFocus
            .Object.SelAlignment=1  &&right
            .Refresh
        Endwith
    Endproc

    Procedure command21.Click
        Local oo,ystr
        oo=Thisform.olertf
        With oo
            .SetFocus
            .Object.SelAlignment=2    &&center \qc
            m.ystr=oo.Object.selRTF
            .selRTF=Strtran(m.ystr,"\qc","\qj")      &&justified
            .Refresh
        Endwith
    Endproc

    Procedure command22.Click
        Local oo,ystr
        oo=Thisform.olertf
        With oo
            .SetFocus
            oo.Object.SelAlignment=2    &&center \qc
            m.ystr=oo.Object.selRTF
            oo.selRTF=Strtran(m.ystr,"\qc","\qd")      &&distributed
            .Refresh
        Endwith
    Endproc

    Procedure command23.Click
        Thisform.olertf.SetFocus
        Local oshell
        oshell=Newobject("wscript.shell")
        oshell.sendKeys("^{z}")
        oshell=Null
        Release oshell
    Endproc

    Procedure command24.Click
        Thisform.olertf.SetFocus
        Local oshell
        oshell=Newobject("wscript.shell")
        oshell.sendKeys("^{y}")
        oshell=Null
        Release oshell
    Endproc

    Procedure command25.Click
        Local oshell
        oshell=Newobject("wscript.shell")
        Thisform.olertf.SetFocus
        oshell.sendKeys("^{C}")   &&copy
        oshell=Null
        Release oshell
    Endproc

    Procedure command26.Click
        Local oshell
        oshell=Newobject("wscript.shell")
        Thisform.olertf.SetFocus
        oshell.sendKeys("^{V}")
        oshell=Null
        Release oshell
    Endproc

    Procedure command27.Click
        Local oshell
        oshell=Newobject("wscript.shell")
        Thisform.olertf.SetFocus
        oshell.sendKeys("^{X}")
        oshell=Null
        Release oshell
    Endproc

    Procedure command28.Click
        Local oshell
        oshell=Newobject("wscript.shell")
        With Thisform.olertf
            .SetFocus()
            oshell.sendKeys("^{home}")     &&FOR UNICODE ITS UTILE
            Inkey(0.1)
            oshell.sendKeys("^{a}")
        Endwith
    Endproc

    Procedure command29.Click
        Thisform.olertf.SetFocus
        Local oshell
        oshell=Newobject("wscript.shell")
        oshell.sendKeys("^{home}")
        oshell=Null
        Release oshell
    Endproc

    Procedure command30.Click
        Thisform.olertf.SetFocus
        Local oshell
        oshell=Newobject("wscript.shell")
        oshell.sendKeys("^{end}")
        oshell=Null
        Release oshell
    Endproc

    Procedure shape1.Click
        Thisform.olertf.SelColor = This.BackColor
    Endproc

    Procedure shape2.Click
        Thisform.olertf.SelColor = This.BackColor
    Endproc

    Procedure shape3.Click
        Thisform.olertf.SelColor = This.BackColor
    Endproc

    Procedure shape4.Click
        Thisform.olertf.SelColor = This.BackColor
    Endproc

    Procedure shape5.Click
        Thisform.olertf.SelColor = This.BackColor
    Endproc

    Procedure shape6.Click
        Thisform.olertf.SelColor = This.BackColor
    Endproc


    Procedure shape7.Click
        Thisform.olertf.SelColor = This.BackColor
    Endproc

    Procedure shape8.Click
        Thisform.olertf.SelColor = This.BackColor
    Endproc

    Procedure shape9.Click
        Thisform.olertf.SelColor = This.BackColor
    Endproc

    Procedure shape10.Click
        Thisform.olertf.SelColor = This.BackColor
    Endproc
Enddefine
*

*Endcode

 

some screenshots of the application.can build a proj and compile as an exe utility.
some screenshots of the application.can build a proj and compile as an exe utility.
some screenshots of the application.can build a proj and compile as an exe utility.
some screenshots of the application.can build a proj and compile as an exe utility.
some screenshots of the application.can build a proj and compile as an exe utility.
some screenshots of the application.can build a proj and compile as an exe utility.

some screenshots of the application.can build a proj and compile as an exe utility.

Published on visual foxpro, richtextbox

To be informed of the latest articles, subscribe:
Comment on this post
V
Splendid! Thank you!
Reply
Y
Merci Mr Vilhlem.toujours ravi de vous voir et revoir !