{ Seventh example of program using the units
  wApplication0.pp  and  wWindow0.pp
  wRichText0.pp
  This unit helps understanding the use of RichText controls.
  It uses a lot the  wDebug0.pp  unit to show the messages handling.
  It is quit complicate, and will be simplified in the library,
  normally in january 2002.

  It uses the  Riched32.dll  file, which should be in your
  windows\system directory.

  This example show how to create a basic text editor
  using the richedit control
  ----------------------------------------------------------------}
program tEx007;

// To tell FreePascal that the application is a Graphical User Interface
// i.e. is running in windows, not in text mode.
{$APPTYPE GUI}

Uses
  Windows
 ,wApplication0
 ,wWindow0
 ,wStatusLine0
 ,wRichText0
 ,wDebug0;

type
  PMyWindow = ^TMyWindow;
  TMyWindow = object(TWindow)
  //"""""""""""""""""""""""""
  // Usually it is better to have a pointer on objects than objects,
  // since pointer can also designate descendent of the objects.
  // More, pointer can be nil, indicating that is has not been initialised.
  oRichEdit   : TRichText;   // RichEdit control contained in the window
  oStatusL    : TStatusLine; // Status line of the main window

  constructor Init(strWinTitlePrm:ShortString);
  destructor Done; virtual;

  // Add a menu to the window
  procedure MenuCreate; virtual;

  // Set  strWinClass=''  to use the class defined in the application object
  procedure WinCreate(strWinClass:ShortString); virtual;

  // Handles the notification messages send from the richedit control
  function WMNotify(wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;

  // Handles the menu messages
  function WMCommand(wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;

  function WindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;
  end; // TMyWindow = object(TWindow)

constructor TMyWindow.Init(strWinTitlePrm:ShortString);
//=====================================================
begin
inherited Init(strWinTitlePrm);

// Initialise the object oStatusL and oEditB
oStatusL.Init(@Self);
oRichEdit.Init(@Self);
end;  // TMyWindow.Init

destructor TMyWindow.Done;
//========================
begin
oStatusL.Done;
oRichEdit.Done;

inherited Done;
end;  // TMyWindow.Init

procedure TMyWindow.MenuCreate;
//=============================
var
  hSubMenu    : HMenu;

begin
hMenuWin := CreateMenu;
hSubMenu := CreateMenu;
AppendMenu(hSubmenu,MF_STRING,101,'&New...');
AppendMenu(hSubmenu,MF_STRING,102,'&Open...');
AppendMenu(hSubmenu,MF_STRING,103,'&Save...');
AppendMenu(hSubmenu,MF_SEPARATOR,0,Nil);
AppendMenu(hSubMenu,MF_String,198,'Open &Debug window');
AppendMenu(hSubmenu,MF_SEPARATOR,0,Nil);
AppendMenu(hSubMenu,MF_String,199,'E&xit');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&File');

hSubMenu := CreateMenu;
AppendMenu(hSubMenu,MF_String,201,'&Undo'#8'Ctrl+Z');
AppendMenu(hSubmenu,MF_SEPARATOR,0,Nil);
AppendMenu(hSubMenu,MF_String,202,'&Cut'#8'Ctrl+X');
AppendMenu(hSubMenu,MF_String,203,'&Copy'#8'Ctrl+C');
AppendMenu(hSubMenu,MF_STRING,204,'&Paste'#8'Ctrl+V');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&Edit');

hSubMenu := CreateMenu;
AppendMenu(hSubMenu,MF_String,301,'&Font...');
AppendMenu(hMenuWin, MF_POPUP, hSubMenu, '&Options');

// this is not a good example, normally a top menu should have a sub-menu
AppendMenu(hMenuWin, MF_STRING, 401, '&Help');
end;  // TMyWindow.MenuCreate

procedure TMyWindow.WinCreate(strWinClass:ShortString);
//=====================================================
// Create the window, and insert an edit box and a status line in it.
begin
// here strWinClass=''.
inherited WinCreate(strWinClass);

// Add a status bar to the edit box
oStatusL.StatusCreate;
oRichEdit.poStatusLine:=@oStatusL;

// Size = the whole client areat
oRichEdit.vXSizeRel:=1;  // if you don't specify, it is set automatically
oRichEdit.vYSizeRel:=1;  // but for clarity, it is better to specify.

oRichEdit.CtrlCreate;
SetFocus(oRichEdit.hWin);

// Sets the limit text size contained in the rich text control.
// by default it is 32767.
// To experiment it, it is set very low at the beginning.
SendMessage(oRichEdit.hWin, EM_EXLIMITTEXT, 0, 100);
end;  // TMyWindow.WinCreate

function TMyWindow.WMNotify(wPar:WPARAM; lPar:LPARAM):LRESULT;
//===========================================================
// Handles the notification messages send from the richedit control
// The handling of notification messages are quite complicate
// and not natural. It will be simplified in the unit wRichText0.pp
var
  prInfo      : ^NMHDR; // info sended with the notification message
  prMsg       : ^MSGFILTER; // info sended in an msgfilter
  prRS        : ^REQRESIZE;
  lMaxLength,
  lTextLen    : longint; // length of the text in the richedit control

begin
WMNotify:=0; // default value

// The  lPar  of a notification message points to a structure containing
// the code of the message.
// Then the code could say that an EN_MSGFilter was send.
// It means that the  lPar  points also to a bigger structure containing
// the original window message received by the control in  prMsg^.msg
// the value of the wPar of this message is in  prMsg^.wParam
// the value of the lPar of this message is in  prMsg^.lParam
prInfo:=Pointer(lPar);

if (prInfo^.code <> EN_MSGFILTER) then
   DBW0(2048, 'WM_NOTIFY,  NotiCode=' + DBNotifToStr(prInfo^.code));

if (prInfo^.code = EN_MSGFILTER) then begin
   // the original message received by the control can be found in
   // the MSGFilter structure, which is pointed by  lPar.
   prMsg:=Pointer(lPar);  // original message
   // wPARAM and LPARAM assiciated with this message.
   DBW0(256, DBMsgToStr(prMsg^.msg) + ITS(prMsg^.wParam) + ITS(LoWord(prMsg^.lParam)) + ITS(HiWord(prMsg^.lParam)));

   // for example many WM_CHAR messages are received.
   // write the character typed in the debug window.
   if (prMsg^.msg = WM_CHAR) then begin
      if (prMsg^.wParam >= 33) then DBW0(128, char(prMsg^.wParam))
      else if (prMsg^.wParam = 32) then DBW0(128, 'SPACE')
      else if (prMsg^.wParam = 13) then DBW0(128, 'RETURN')
      else if (prMsg^.wParam =  9) then DBW0(128, 'TAB')
      else if (prMsg^.wParam =  8) then DBW0(128, 'BACK SPACE')
      else DBW0(128, 'code = ' + ITS(prMsg^.wParam));

      // test if the buffer to store characters is nearly full
      // it is not satisfactory to do it this way, but I don't know
      // a better way.
      lTextLen:=GetWindowTextLength(oRichEdit.hWin);
      lMaxLength:=SendMessage(oRichEdit.hWin, EM_GETLIMITTEXT, 0, 0);
      if (lTextLen + 50 > lMaxLength) then begin
         // increase only by a small amout, as an example
         SendMessage(oRichEdit.hWin, EM_EXLIMITTEXT, 0, lMaxLength + 10); // increase buffer size
         DBW0(16, 'increase buffer size to' + ITS(lMaxLength + 3));
         end;
      end;
   end;

if (prInfo^.code = EN_REQUESTRESIZE) then begin
   prRS:=Pointer(lPar); // contain the new size
   DBW0(16384, 'EN_REQUESTRESIZE' + ITS(prRS^.rc.left) + ITS(prRS^.rc.top));
   DBW0(16384, '                ' + ITS(prRS^.rc.right) + ITS(prRS^.rc.bottom));
   end;
{
// these noticication codes are received in the WM_Notify
DBW0(8192, 'EN_MSGFILTER=' + ITS(EN_MSGFILTER)); // = 1792
DBW0(8192, 'EN_REQUESTRESIZE=' + ITS(EN_REQUESTRESIZE)); // = 1793
DBW0(8192, 'EN_SELCHANGE=' + ITS(EN_SELCHANGE)); // = 1794
DBW0(8192, 'EN_DROPFILES=' + ITS(EN_DROPFILES)); // = 1795
DBW0(8192, 'EN_PROTECTED=' + ITS(EN_PROTECTED)); // = 1796
DBW0(8192, 'EN_CORRECTTEXT=' + ITS(EN_CORRECTTEXT)); // = 1797
DBW0(8192, 'EN_STOPNOUNDO=' + ITS(EN_STOPNOUNDO)); // = 1798
DBW0(8192, 'EN_IMECHANGE=' + ITS(EN_IMECHANGE)); // = 1799
DBW0(8192, 'EN_SAVECLIPBOARD=' + ITS(EN_SAVECLIPBOARD)); // = 1800
DBW0(8192, 'EN_OLEOPFAILED=' + ITS(EN_OLEOPFAILED)); // = 1801

DBW0(4096, 'NM_OUTOFMEMORY =' + ITS(NM_OUTOFMEMORY)); // = -1
DBW0(4096, 'NM_CLICK =' + ITS(NM_ClICK));             // = -2
DBW0(4096, 'NM_DBLCLK =' + ITS(NM_DBLCLK));           // = -3
DBW0(4096, 'NM_RETURN=' + ITS(NM_RETURN));            // = -4
DBW0(4096, 'NM_RCLICK=' + ITS(NM_RCLICK));            // = -5
DBW0(4096, 'NM_RDBLCLK=' + ITS(NM_RDBLCLK));          // = -6
DBW0(4096, 'NM_SETFOCUS=' + ITS(NM_SETFOCUS));        // = -7
DBW0(4096, 'NM_KILLFOCUS =' + ITS(NM_KILLFOCUS));     // = -8

// these notification codes are received in the WM_Command
DBW0(8192, 'EN_SETFOCUS=' + ITS(EN_SETFOCUS));       // = 256
DBW0(8192, 'EN_KILLFOCUS=' + ITS(EN_KILLFOCUS));       // = 512
DBW0(8192, 'EN_CHANGE=' + ITS(EN_CHANGE));       // = 768
DBW0(8192, 'EN_UPDATE=' + ITS(EN_UPDATE));          // = 1024
}
WMNotify:=inherited WMNotify(wPar, lPar);
end; //  TMyWindow.WMNotify

function TMyWindow.WMCommand(wPar:WPARAM; lPar:LPARAM):LRESULT;
//=============================================================
// Handles the menu messages
Var
  wNrMenu     : word;
  wNoticode   : word;
  lMaxSize    : longint;

begin
WMCommand:=0; // default value
wNotiCode := HiWord(wPar);

// This is here only to have a small look to see how it works.
// It is quite complicate, and will be simplified in the
// wRichText0.pp unit.

// write the notification code in the debugging window.
DBW0(4096, 'WM_COMMAND, NotiCode=' + DBNotifToStr(wNotiCode));

if (wNotiCode = EN_CHANGE) then begin  // EN_CHANGE = 768
   // Editor has changed
   If (SendMessage(oRichEdit.hWin, EM_GetModify, 0, 0) <> 0) then
        oStatusL.SetStatusText(2,'Modified')
   else oStatusL.SetStatusText(2,'');
   exit;
   end;

if (wNotiCode = EN_UPDATE) then begin  // EN_UPDATE = 1024
   // can treat the en_Update notif. code.
   end;

if (wNotiCode = EN_KILLFOCUS) then begin  // EN_KILLFOCUS = 512
   // can treat the EN_KILLFOCUS notif. code.
   end;

if (wNotiCode = EN_SETFOCUS) then begin  // EN_SETFOCUS = 256
   // can treat the EN_SETFOCUS notif. code.
   end;

if (wNotiCode = EN_MAXTEXT) then begin  // EN_MAXTEXT = 1281
   // Buffer full, no more characters are accepted.
   // this is received after the last typed character has been rejected.
   // increase by a small amout, to experiment it.
   lMaxSize:=oRichEdit.GetClipboardRichTextLength;
   DBW0(16, 'Buffer full, maxSize =' + ITS(lMaxSize));

   // HOW CAN I increase the buffer size before the character is rejected?
   // For the moment, at every typing of a character, a test is made
   // to see if the buffer size has to be increased.
   // it should be done also at the past command and
   // while loading a file.
   end;

if (wNotiCode = EN_ERRSPACE) then begin
   DBW0(32, 'EN_ERRSPACE');
   end;

if (wNotiCode = EN_VSCROLL) then begin
   DBW0(32, 'EN_VSCROLL');
   end;

if (wNotiCode = EN_HSCROLL) then begin
   DBW0(32, 'EN_HSCROLL');
   end;

if (lPar <> 0) then begin
   WMCommand:=inherited WMCommand(wPar, lPar);
   exit;
   end;

// for the menu, lPar = 0
wNrMenu   := LoWord(wPar);
case wNrMenu of
   101 : oRichEdit.NewText;
   102 : oRichEdit.LoadRICH;  // here text buffer size might be too small. See next version to have it correct.
   103 : oRichEdit.SaveRICH;
   198 : DBW0(0, ''); // opens the debugging window.
   199 : PostMessage(hWin, WM_Close,0,0);

   201 : oRichEdit.UndoText;
   202 : oRichEdit.CutText;
   203 : oRichEdit.CopyText;
   204 : oRichEdit.PasteText;
   205 : oRichEdit.SelectAllText;
   301 : oRichEdit.SelectFont;

   401 : MessageBox( hWin, 'Use the debugging window to see the messages send to the main window. Use the mask options.', 'Use the debug window', MB_OK Or MB_IconInformation);
   else WMCommand:=inherited WMCommand(wPar, lPar);
   end;  // case
end;  // TMyWindow.WMCommand

function TMyWindow.WindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT;
//====================================================================================
// All window messages are send here.
Var
  rRec        : rect;
  wStatH      : Word;
  alEdges     : array[1..2] of LongInt;

Begin
WindowProc := 0; // Default return value when processing a message

// to see most messages comming to the main window.
if (wMsg <> WM_MouseMove)   and (wMsg <> WM_NCMouseMove) and
   (wMsg <> WM_MENUSELECT )   and (wMsg <> WM_ENTERIDLE ) and
   (wMsg <> WM_SetCursor)   and (wMsg <> WM_NCHittest) and
   (wMsg <> WM_Move)        and (wMsg <> WM_NCActivate) then
   DBW0(1024, DBMsgToStr(wMsg) + ITS(wPar) + ITS(lPar));

Case wMsg Of
   WM_Close : begin
      oRichEdit.AskSave;
      WindowProc:=inherited WindowProc(hWindow, wMsg, wPar, lPar);
      end;
//   WM_Destroy : PostQuitMessage (0); // This is the default behaviour.
//              This should not be treated here, or at least the
//              inherited WindowProc should be called.
//              This allows to save the window position and size in a file
   WM_SetFocus : SetFocus(oRichEdit.hWin);
   WM_Size : begin
      GetClientRect(oStatusL.hWin, @rRec);
      wStatH := word(rRec.Bottom - rRec.Top);
      GetClientRect(hWindow, @rRec);
      MoveWindow (oRichEdit.hWin,0,0, rRec.Right, rRec.Bottom - wStatH, False);
      MoveWindow (oStatusL.hWin,0, rRec.Bottom - wStatH, rRec.Right, rRec.Bottom, False);

      // Define the position of the separation in the Status line
      alEdges[1] := rRec.Right  - rRec.Left - 80;
      alEdges[2] := rRec.Right  - rRec.Left;
      SendMessage(oStatusL.hWin, SB_SETPARTS, 2, LongInt(@alEdges));

      // to send the notification message EN_REQUESTRESIZE
      // If one want to resize the window. Not usefull here.
//      SendMessage(oRichEdit.hWin, EM_REQUESTRESIZE, 0, 0);
      end; // WM_Size
   WM_Command : WindowProc:=WMCommand(wPar, lPar);
   WM_Notify :  WindowProc:=WMNotify(wPar, lPar);
   WM_CtlColorEdit : begin
      SetTextColor(wPar, oRichEdit.TheColor);
      Exit(GetSysColorBrush(COLOR_WINDOW));
      end;

   else begin // Case wMsg Of
      // Default processing of the messages.
      WindowProc:=inherited WindowProc(hWindow, wMsg, wPar, lPar);
      end; // Case wMsg Of
   End; // Case wMsg Of

End;  // TMyWindow.WindowProc

var
  oApp        : TApplication;
  poMyMainWin : PMyWindow;

Begin // MAIN ******
// Name under which the main window is registered. Spaces are not allowed
oApp.Init('Example007');

// Creation of the main window
new(poMyMainWin, Init('Title of the Example007 (Ex007.pp) Window'));

// The App.WindowClass can be modified here, if wanted. (Not usual)
oApp.Run;
oApp.Done;  // The main window object is disposed here.
End. // program tEx007;

