Rich Edit Text Object Model project

[José Roca]

Hello to all,

After several years without programming, I realised that I was forgetting a lot of my knowledge about the use of Freebasic, which, little by little, has been improving and becoming more solid.

To refresh my knowledge, I have started a new project involving the Rich Edit control, with several classes that wrap the Text Object Model (TOM2) interfaces.

This will take me a while, because besides writing and testing the code, I also document it, and this takes more work than the other.

Here you can find what I have done so far. The files with the extension .md are the documentation in markdown language. The CTextDocument2 class file is finished and I'm working on the CTextRange2 class file.

https://github.com/JoseRoca/WinFBX/tree/master/docs/RichEdit

[Charles Pegge]

Wow! This is so huge 

[José Roca]

There are still three more interfaces: IRichEditOle, ITExtStrings and ITexStoryRanges.

Then to convert examples like this one:
https://forum.it-berater.org/index.php/topic,4377.msg15298.html#msg15298

I also plan to write "high level" functions for the most common used methods, like this one:

Code Select Expand

' ========================================================================================
' Gets the plain text in this range.
' ========================================================================================
PRIVATE FUNCTION AfxRichEditTOM_GetText (BYVAL hRichEdit AS HWND, BYVAL cpActive AS LONG = 0, BYVAL cpAnchor AS LONG = 0, BYVAL Flags AS LONG = 0) AS CBSTR
   CTOM_DP("AfxRichEditTOM_GetText")
   DIM cbsText AS CBSTR
   ' // Create an instance of the CTextDocument2 class
   DIM pCTextDoc AS CTextDocument2 = hRichEdit
   IF pCTextDoc.TextDocumentPtr = NULL THEN RETURN cbsText   ' // Return an empty string
   ' // Create a range
   IF cpActive < 0 THEN cpActive = 0
   DIM numChars AS LONG = RichEdit_GetTextLength(hRichEdit)   ' // Length of the text
   IF cpAnchor < 0 THEN cpAnchor = numChars
   IF cpAnchor > numChars THEN cpAnchor = numChars
   ' // Get the text
   DIM pCRange2 AS CTextRange2 = pCTextDoc.Range2(cpActive, cpAnchor)
   IF pCRange2.TextRangePtr = NULL THEN RETURN cbsText   ' // Return an empty string
   cbsText = pCRange2.GetText2(Flags)
   RETURN cbsText
END FUNCTION
' ========================================================================================

The first Text Object Model (TOM) was much smaller, but could not be used with languages like Power BASIC because the classes used the thiscall calling convention. TOM2 uses stdcall.

BTW FreeBasic has added support for thiscall and fastcall.

[José Roca]

Compound syntax can also be used, e.g.

Code Select Expand

DIM cbsText AS CBSTR = CTextRange2(CTextDocument2(hRichEdit).Range2(0, numChars)).GetText2(0)

Can substitute the above function, although I never have been a fan of this syntax because you can't check intermediate results, and if one of the returned intermediate pointers is null, it will GPF.

However, I have designed the FreeBasic wrapper classes in a way that allows to use it.

[Frank Brübach]

Hello Jose thats a great Work and Job.. many thanks :-)

I have Made a First Test and its running all fine Here

Code Select Expand

'
' cTom_01.bas 'file

' ########################################################################################
' Microsoft Windows
' File: CTOM_01.bas
' Contents: CWindow Rich Edit example
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 José Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#define UNICODE
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/AfxRichEdit.inc"
#define _CTOM_DEBUG_ 1
#Include ONCE "Afx/CTOM.inc"
#INCLUDE ONCE "Afx/AfxRichEditTOM.inc"
USING Afx

CONST IDC_RICHEDIT = 1001
CONST IDC_TEST = 1002

DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                          BYVAL hPrevInstance AS HINSTANCE, _
                          BYVAL szCmdLine AS ZSTRING PTR, _
                          BYVAL nCmdShow AS LONG) AS LONG

   END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)

' // Forward declaration
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
                  BYVAL hPrevInstance AS HINSTANCE, _
                  BYVAL szCmdLine AS ZSTRING PTR, _
                  BYVAL nCmdShow AS LONG) AS LONG

   ' // Set process DPI aware
   AfxSetProcessDPIAware

   DIM pWindow AS CWindow
   pWindow.Create(NULL, "CWindow with a Rich Edit control", @WndProc)
   pWindow.SetClientSize(500, 320)
   pWindow.Center

   ' // Add a rich edit control without coordinates (it will be resized in WM_SIZE)
   DIM hRichEdit AS HWND = pWindow.AddControl("RichEdit", , IDC_RICHEDIT, "RichEdit box test")
   SetFocus hRichEdit

   ' // Add a button without coordinates (it will be resized in WM_SIZE)
   pWindow.AddControl("Button", , IDCANCEL, "&Close", 0, 0, 75, 23)
   pWindow.AddControl("Button", , IDC_TEST, "&Test", 0, 0, 75, 23)

   ' // Dispatch Windows messages
   FUNCTION = pWindow.DoEvents(nCmdShow)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Main window callback procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   SELECT CASE uMsg

      CASE WM_COMMAND
         SELECT CASE GET_WM_COMMAND_ID(wParam, lParam)
            ' // If ESC key pressed, close the application sending an WM_CLOSE message
            CASE IDCANCEL
               IF GET_WM_COMMAND_CMD(wParam, lParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
            CASE IDC_TEST
               DIM hRichEdit AS HWND = GetDlgItem(hwnd, IDC_RICHEDIT)
               AfxMsg AfxRichEditTOM_GetText(hRichEdit, 3, -1)
               AfxMsg AfxRichEditTOM_ChangeCase(hRichEdit, tomToggleCase)
               DIM chrRange AS CHARRANGE = TYPE<CHARRANGE>(3, 12)
               RichEdit_ExSetSel(hRichEdit, @chrRange)
               AfxMsg STR(AfxRichEditTOM_GetCch(hRichEdit, 3, 10))
               AfxMsg RichEdit_GetRtfText(hRichEdit)

               SCOPE
                  DIM pCTextDocument2 AS CTextDocument2 = hRichEdit
                  DIM pCRange2 AS CTextRange2 = pCTextDocument2.Range2(3, 8)
                  IF pCRange2 THEN pcRange2.SetChar(ASC("X"))
               END SCOPE

         END SELECT

      CASE WM_SIZE
         ' // If the window isn't minimized, resize it
         IF wParam <> SIZE_MINIMIZED THEN
            ' // Resize the controls
            DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
            IF pWindow THEN
               pWindow->MoveWindow GetDlgItem(hwnd, IDC_RICHEDIT), 100, 50, pWindow->ClientWidth - 200, pWindow->ClientHeight - 150, CTRUE
               pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 95, pWindow->ClientHeight - 35, 75, 23, CTRUE
               pWindow->MoveWindow GetDlgItem(hwnd, IDC_TEST), pWindow->ClientWidth - 195, pWindow->ClientHeight - 35, 75, 23, CTRUE
            END IF
         END IF

        CASE WM_DESTROY

         ' // End the application by sending an WM_QUIT message
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   ' // Default processing of Windows messages
   FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

What was your Motivation to start programming with freebasic and AfxRichEdit  again? 

[Charles Pegge]

José, Are there any COM interfaces that use thiscall or fastcall?. These calling conventions are redundant in 64bit anyway.

PS
I came accross this post:
https://github.com/microsoft/win32metadata/issues/1053

[José Roca]

The only ones that I know are these belonging to the first version of the Text Object Model (TOM). This includes the RichEdit classes (except IRichEditOle) and ITextHost and ITextServices. I suspect that I was a mistake (thiscall is the default calling convention for C++ classes) that they have corrected in TOM2, that uses stdcall. You have to create the RichEdit control using the RichEdit50W class instead of older classes (for example, RichEdit20), that use thiscall.

The addition of thiscall and fastcall in FreeBasic is one of the needed steps in its attempt to add support to use non COM C++ classes that use these calling conventions. It also can be used with FreeBasic classes, but it is not the default (you have to add the Extern C++ directive or specify the calling convention in the declarations of the procedures).

Code Select Expand

declare Sub name __Thiscall [Overload] [Alias "alias"] ( parameters )
declare Function name __Thiscall [Overload] [Alias "alias"] ( parameters ) [ ByRef ] As return_type


[José Roca]

Regarding the problems of GPFs with the compound syntax if one of the intermediate result is a null pointer, I will add checking for null pointers in all the methods of my classes.

I will also add optional parameters with default values to some of the methods.

[José Roca]

> What was your Motivation to start programming with freebasic and AfxRichEdit  again?

It's good for my mind. Solving complex problems keeps your brain sharp, which is essential at my advanced age.