unit wRichText0;

{ Feel free to use this unit as you want.
  First developped by Bernard Gisin

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

  to facilitate to have a RichEdit control in a window,
  to edit text.
  ----------------------------------------------------------------}

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

INTERFACE
//"""""""

Uses wStatusLine0, wControl0, wWindowBase0, wGlobals2, Windows;

type
  PRichText0 = ^TRichText0;
  TRichText0 = object(TControl)
  //"""""""""""""""""""""""""""
//  hWin     : HWND;  // Handle on the edit box, got from TWindowBase
//  hParent : HWND;  // Handle on the parent, got from TWindowBase
//  poParent: PWindowBase0;  // Pointer on the parent, got from TWindowBase

  // Memorise the address of the previous window message handler.
//  lPreviousAddress : longint; defined in TControl0

  TheFont     : HFont;
  TheLogFont  : TLogFont;
  TheColor    : DWORD;

  strFilePath : ShortString;
  // complete filename, with the directory and extension.

  poStatusLine : PStatusLine0;
  // Status line. By default it is NIL,
  // but if not, the status line is modified with the filename

  strStatusModifiedText : string[80];
  // Text in the status line if text modified and status line exist.
  // Maybe this will change later ?????!!!!!

  fSavedOnce : boolean;
  // Te see if the filename has been defined.

  fModified : boolean;
  // Has been the text modified ?

  lTextBufferSize : longint;
  // Memoriszed the buffer size containing the text.

  constructor Init(poParentW:PWindowBase0);
  destructor  Done; virtual;

  procedure SetModifyState(fModif:boolean); virtual;
  // sets the  fModified  state, and change the
  // text in the status line.

  function SelectFile(fOpen:Boolean): Boolean; virtual;
  // from a dialog box, select a file to save or to load
  // Use and store the filename in strFilePath

  procedure SaveTEXT; virtual;  // not usefull anymore, will be removed.

  procedure SaveRICH; virtual;
  // saves the texte, either on  RTF  format or no format,
  // depending on the extension.
  // do not ask to save

  procedure SaveRICHas; virtual;
  // Saves a text either in a rich text format or a normal text without format,
  // depending on the extension.
  // ask before saving, opening a dialog box

  procedure AskSave; virtual;

  procedure LoadTEXT; virtual;  // not usefull anymore, will be removed.
  // load a normal text, without format.

  function LoadRICH:boolean; virtual;
  // load a text from a file in rich text format, or text without format,
  // depending on the extension
  // Return True if a text has been loaded,
  // FALSE if the operation was canceled

  procedure NewText; virtual;
  procedure SelectFont; virtual;

  procedure UndoText; virtual;
  // Undo last action

  procedure SelectAllText; virtual;
  // Select all text.

  procedure CutText; virtual;
  // Cut text.

  procedure CopyText; virtual;
  // Copy text.

  procedure PasteText; virtual;
  // Paste text.

  procedure AppendText(strS:ShortString); virtual;
  // Add a line of text at the end of the existing text.

  function GetTextLength:longint; virtual;
  // Get the length of the text in the buffer.

  function GetClipboardRichTextLength:longint; virtual;
  // Get the length of the text in the Clippboard.

  procedure AutoSize(nLeft,nTop:integer; var nWidth,nHeight:int32); virtual;
  // Computes the sizes automatically, if no sizes where specified.
  // Gives as infor the values of nLeft and nTop
  // Units are pixels

  procedure CtrlCreate; virtual;
  // Create a RichEdit control window.
  // if poStatusLine <> NIL, use it to show the modify state, and filename.

  procedure CtrlNotifMessageHandle(wNotif:UINT; lPar:LPARAM); virtual;
  // Handle notification messages, see wControl0.pp for doc.
  // It can either come from a WM_COMMAND or from a WM_NOTIFY
  // received by the parent.

  function CtrlWindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;
  // Handles the window messages
  // It is usually overriden
  // A SendMessage(hWin, ...) must never be called from here, since
  // it would be a calling loop
  end; // TRichText0 = object(TControl)
  TRichText =  TRichText0;
  PRichText = ^TRichText;

IMPLEMENTATION
//""""""""""""

Uses wUtiles0, wErrors0, wDebug0, Strings;

var nNotUsed : integer; // only to avoid an error message while compliling in DevPascal 1.9

constructor TRichText0.Init(poParentW:PWindowBase0);
//==================================================
begin
inherited Init(poParentW);

wWindowType:=GGLCTE_CTRL_RICHEDIT;

strClassName  :='RICHEDIT';
strCtrlLabel  :='';
// strCtrlHint   :='';      // can be redefined in the main application

dwExStyle :=WS_EX_ClientEdge; //  or WS_EX_ACCEPTFILES;
dwStyle   :=  WS_CHILD
              or ES_Left
//              or ES_CENTER
//              or ES_RIGHT
              or ES_AUTOHSCROLL
              or ES_AUTOVSCROLL
              or ES_NOHIDESEL
//              or ES_NUMBER
//              or ES_UPPERCASE
//              or ES_WANTRETURN
//              or ES_LOWERCASE
              or WS_HScroll // to have an horizontal scroll bar
              or WS_VScroll // to have a vertical scroll bar
              or ES_MULTILINE
              ;

TheFont     :=0;
// TheLogFont :=  not initialised !!!
TheColor    :=0; // black
strFilePath:='.\Unknown.rtf';

poStatusLine:=NIL;
strStatusModifiedText:='Modified';

fSavedOnce :=FALSE; // filename not defined, ask before saving

fModified :=FALSE;

lTextBufferSize:=100000; // default text buffer size
end;  // TRichText0.Init

destructor  TRichText0.Done;
//==========================
begin
inherited Done;
end;  // TRichText0.Done

procedure TRichText0.SetModifyState(fModif:boolean);
//==================================================
// sets the  fModified  state, and change the
// text in the status line.
begin
fModified:=fModif;

if (poStatusLine <> NIL) then begin
   poStatusLine^.SetStatusText(1, strFilePath);
   if fModif then poStatusLine^.SetStatusText(2,strStatusModifiedText)
   else           poStatusLine^.SetStatusText(2,'');
      end;
end;  // TRichText0.SetModifyState

Function TRichText0.SelectFile(fOpen:Boolean):Boolean;
//====================================================
Const
  Filter : PChar = 'Text files (*.txt)'#0'*.txt'#0+
                   'Rich files (*.rtf)'#0'*.rtf'#0+
                   'All files (*.*)'#0'*.*'#0#0;
Var
  NameRec : OpenFileName;
  strDir,     // to split the filename into its parts.
  strName,
  strExt      : ShortString;
  nFirst,     // position a of period '.' in the string
  nSec,        // position a second of period '.' in the string
  nFIndex     : integer; // which filter index to use
  fOK         : boolean; // filename selected & OK pressed in the dialog box

Begin
// determine the default extension.
FileSplit(strFilePath, strDir, strName, strExt);

if (strExt = '.txt') or (strExt = '.Txt') or
   (strExt = '.TXT') then begin
   // .txt default extension
   strExt:='txt' + #0;
   nFIndex:=1;
   end
else if (strExt = '.rtf') or (strExt = '.Rtf') or
   (strExt = '.RTF') then begin
   // .rtf default extension
   strExt:='rtf' + #0;
   nFIndex:=2;
   end
else begin
   // do not change the extension
   strExt:=copy(strExt,2,100) + #0;
   nFIndex:=3;
   end;

strDir  := strDir  + #0; // default directory
strName := strName + '.' + strExt + #0; // default filename

// Fills a structure for the GetOpenFileName or GetSaveFileName procedures
FillChar(NameRec,SizeOf(NameRec),0);
With NameRec Do Begin
   lStructSize     := SizeOf(NameRec);
   hWndOwner       := hParent;
   lpStrFilter     := Filter;
   nFilterIndex    := nFIndex;
   lpStrFile       := @strName[1];
   nMaxFile        := Max_Path;
   lpstrInitialDir := @strDir[1];
   lpStrDefExt     := @strExt[1];  // default extension

   Flags       := OFN_Explorer Or OFN_HideReadOnly;
   If fOpen Then Flags := Flags Or OFN_FileMustExist
   else          Flags := Flags or OFN_OVERWRITEPROMPT;
   End;  // With NameRec Do Begin

If fOpen Then fOK := GetOpenFileName(@NameRec)
Else          fOK := GetSaveFileName(@NameRec);

SelectFile:=fOK; // return value

if (not fOK) then exit;  // no selection done

// Convert null terminated string to ShortString
strName[0]:=Char(StrLen(@strName[1]));

// if a new extension has been typed, then a default extension is added.
// here, we remove the added '.txt' or '.rtf' extension if it was added.
nFirst:=Pos('.', strName); // search for a period in the name
if (nFirst > 0) then
     nSec  :=Pos('.', copy(strName, nFirst+1, 250))  // search a second period
else nSec:=0;

if (nSec > 0) then begin
   // remove what follows the secon period
   strFilePath:=copy(strFilePath, 1, nFirst+nSec-1);  // filename to return.
   end
else strFilePath:=strName;  // filename to return, unchanged.
End;  // TRichText0.SelectFile

procedure TRichText0.SaveTEXT;
//============================
Var
  nErr        : integer;
  lLen        : Longint;
  pcH         : PChar;
  fOut        : File;

Begin
If SelectFile(False) Then Begin
   {$i-}
   Assign(fOut, strFilePath);
   Rewrite(fOut,1);
   lLen := GetWindowTextLength(hWin);
   GetMem(pcH, lLen+1);
   pch[lLen] := #0;
   If (lLen > 0) Then Begin
      GetWindowText(hWin, pcH, lLen+1);
      BlockWrite(fOut, pcH^, lLen);
      End;

   Close(fOut);
   nErr:=IOResult;
   fSavedOnce :=(nErr = 0); // filename defined.

   FreeMem(pcH, lLen+1);

   SetModifyState(FALSE);

   SendMessage(hWin,EM_SetModify,0,0);
   End;
End;  // TRichText0.SaveTEXT

type
  PLongInt = ^longint;
  TArrayOfBytes = array[0..10000000] of byte; // the size doesn't matter
  PArrayOfBytes = ^TArrayOfBytes;

var
  glfOut        : File; // to write in a file
  glfIn         : File; // to read from a file

Function RichTextStreamCallback( dwCookie:DWORD; pabBuff:PArrayOfBytes; lNbByteOut:longint;
{==============================} plNbByte:PLongInt):DWORD; stdcall; export;
// called by the rich edit control to give the its content.
// dwCookie = parameter send in the EDITSTREAM.
// pabBuff = buffer containing the text in rich format of the richedit control
// lNbByteOut = number of bytes in the buffer.
// plNbByte = Pointer to a variable that receives the number of bytes
//            actually read or written. I don't understand what it is ?
var
  lNbRidden   : integer; // number of bytes fidden from the file

begin

if (dwCookie = 0) then begin
   // write to the file
   {i-}
   If (lNbByteOut > 0) Then Begin
      BlockWrite(glfOut, pabBuff^, lNbByteOut);
      End;

   // The documentation how to save the data is very unclear.
   // But it seems that you
   // must return the number of byte writte to continue
   plNbByte^:=lNbByteOut;

   RichTextStreamCallback:=0;  // should return 0 to say 'no errors'
   end
else begin
   // Read from the file
   {i-}
   If (not eof(glfIn)) and (lNbByteOut > 0) Then Begin
      BlockRead(glfIn, pabBuff^, lNbByteOut, lNbRidden);

      // tells the control how many bytes have been ridden.
      plNbByte^:=lNbRidden;
      End
   else plNbByte^:=0;  // transfert completed.

   // For StreamIn, i.e. writing data to the control, you must
   // return the number of bytes copied in the buffer.
   // or 0 if the transfert is completed.
   // The last call, no bytes are ridden, thus plNbByte^ = 0
   // this means that the transfert has been completed.

   // return value to say that it worked ok.
   RichTextStreamCallback:=0
   end;
end;  // RichTextStreamCallback

procedure TRichText0.SaveRICH;
//============================
// saves the texte, either on  RTF  format or no format,
// depending on the extension.
// do not ask to save
Var
  strFPath    : ShortString;
  rES         : EDITSTREAM;
  nErr        : integer;
  strDir,     // to split the filename into its parts.
  strName,
  strExt      : ShortString;
  wSF_State   : word; // = SF_RTF or SF_TEXT

Begin
// test if the file has already been save once.
// if not, ask under which name it should be saved.
if (not fSavedOnce) then SaveRICHas;

   // sets the filename.
   strFPath:=strFilePath;

   // depending on the extension, save as .rtf file or normal text file.
   FileSplit(strFPath, strDir, strName, strExt);
   if (strExt = '.rtf') or (strExt = '.Rtf') or
      (strExt = '.RTF') then wSF_State:=SF_RTF  // saving as rich   text format
   else                      wSF_State:=SF_TEXT; // saving as normal text format

   // opens to write into the file
   {$i-}
   Assign(glfOut, strFilePath);
   Rewrite(glfOut,1);

   // define a callback function to retreive the text from the richedit control
   rES.dwCookie:=0;  // user data, =0 for writing, =1 for reading
   rES.dwError:=0;   // no error initialized
   rES.pfnCallback :=EDITSTREAMCALLBACK(@RichTextStreamCallback);
   // gets the content of the RichEdit control.
   SendMessage(hWin,EM_STREAMOUT, wSF_State, LPARAM(@rES));

   // no errors should occur
   if (rES.dwError <> 0) then begin
      ErrorWrite( ERR_TRichText0_SaveRICH_1, 'in TRichText0.SaveRICH');
      ErrorComment( ERR_TRichText0_SaveRICH_1,
         'Error received from Windows while saving using streaming.');
      ErrorComment( ERR_TRichText0_SaveRICH_1,
         'dwError = ' + ITS(rES.dwError) + '    What does it mean ?');
      end;

   Close(glfOut);
   nErr:=IOResult;
   if (nErr <> 0) then begin
      ErrorWrite( ERR_TRichText0_SaveRICH_2, 'in TRichText0.SaveRICH');
      ErrorComment( ERR_TRichText0_SaveRICH_2,
         'IO Error while saving. Error No =' + ITS(nErr));
      end;

   fSavedOnce :=(nErr = 0); // filename defined.

   // change the status line
   SetModifyState(FALSE);

   // Tells the richedit control that is is has not been modifyed
   // since the last save
   SendMessage(hWin,EM_SetModify,0,0);
End;  // TRichText0.SaveRICH

procedure TRichText0.SaveRICHas;
//==============================
// saves the texte, either on  RTF  format or no format,
// depending on the extension.
Begin
// opens a dialog box to get the filename
If SelectFile(False) Then Begin
   fSavedOnce :=TRUE;  // filename is defined.
   SaveRICH;
   end;
End;  // TRichText0.SaveRICHas

Procedure TRichText0.AskSave;
//===========================
Const
  BoxType = MB_IconQuestion Or MB_YesNo;
Begin
If (SendMessage(hWin, EM_GetModify, 0 ,0) <> 0) Then Begin
   If MessageBox(hParent, 'Save text?', 'Edited', BoxType)=IdYes Then Begin
      SaveRICHas;
      End;
   End;
End;  // TRichText0.AskSave

Procedure TRichText0.LoadTEXT;
//============================
Var
  nErr        : integer;
  fIn         : File;
  lLen        : LongInt;
  pcH         : PChar;

Begin
AskSave;

If SelectFile(True) Then Begin
   {$i-}
   Assign(fIn, strFilePath);
   Reset(fIn,1);
   lLen := FileSize(fIn);
   GetMem(pcH, lLen+1);
   pcH[lLen] := #0;
   If (lLen > 0) Then BlockRead(fIn, pcH^, lLen);
   Close(fIn);
   nErr:=IOResult;
   fSavedOnce :=(nErr = 0); // filename defined.

   SetWindowText(hWin, pcH);
   SendMessage(hWin,EM_SetModify,0,0);
   FreeMem(pcH, lLen+1);

   SetModifyState(FALSE);
   End;
End;  // TRichText0.LoadTEXT

function TRichText0.LoadRICH:boolean;
//===================================
// Load a text, supposing it is in a rich text format.
// The size of the RichText buffer increases automatically to
// support all text it gets.
// Return True if a text has been loaded,
// FALSE if the operation was canceled
var
  rES         : EDITSTREAM;
  wSF_State   : word; // = SF_RTF or SF_TEXT
  strDir,     // to split the filename into its parts.
  strName,
  strExt      : ShortString;
  nErr        : integer;

Begin
AskSave;

LoadRICH:=FALSE;

If SelectFile(True) Then Begin
   // depending on the extension, save as .rtf file or normal text file.
   FileSplit(strFilePath, strDir, strName, strExt);
   if (strExt = '.rtf') or (strExt = '.Rtf') or
      (strExt = '.RTF') then wSF_State:=SF_RTF  // saving as rich   text format
   else                      wSF_State:=SF_TEXT; // saving as normal text format

   // opens to write into the file
   {$i-}
   Assign(glfIn, strFilePath);
   Reset(glfIn,1);

   // define a callback function to retreive the text from the richedit control
   rES.dwCookie:=1;  // user data, not used
   rES.dwError:=0;   // no error initialized
   rES.pfnCallback :=EDITSTREAMCALLBACK(@RichTextStreamCallback);
   // gets the content of the RichEdit control.
   SendMessage(hWin, EM_STREAMIN, wSF_State, LPARAM(@rES));

   // no errors should occur
   if (rES.dwError <> 0) then begin
      ErrorWrite( ERR_TRichText0_LoadRICH_1, 'in TRichText0.LoadRICH');
      ErrorComment( ERR_TRichText0_LoadRICH_1,
         'Error received from Windows while loading using streaming.');
      ErrorComment( ERR_TRichText0_LoadRICH_1,
         'dwError = ' + ITS(rES.dwError) + '    What does it mean ?');
      end;

   Close(glfIn);
   nErr:=IOResult;
   if (nErr <> 0) then begin
      ErrorWrite( ERR_TRichText0_LoadRICH_2, 'in TRichText0.LoadRICH');
      ErrorComment( ERR_TRichText0_LoadRICH_2,
         'IO Error while loading. Error No =' + ITS(nErr));
      end;

   fSavedOnce :=(nErr = 0); // filename defined.

   if (fSavedOnce) then
      SendMessage(hWin,EM_SetModify,0,0); // text not modified

   // sets the status line with the filename and don't say 'changed'
   SetModifyState(FALSE);
   LoadRICH:=TRUE;
   End;
End;  // TRichText0.LoadRICH

Procedure TRichText0.NewText;
//===========================
Const
  Empty : PChar = '';
Begin
AskSave;
strFilePath := 'Unsaved.rtf';

// clear the text in the RichEdit control.
SendMessage(hWin,WM_SetText,1, LongInt(Empty));
SendMessage(hWin,EM_SetModify,0,0); // text not modified

SetModifyState(FALSE);
End;  // TRichText0.NewText

procedure TRichText0.SelectFont;
//==============================
var
  ChooseFontRec : TChooseFont;
  rCF         : CHARFORMAT;
//  hDCWin      : HDC;

begin
// gets information about the actual format of the selected text.
with TheLogFont do begin
   // must tell the size of the structure, before sending the @rCF parameter.
   rCF.cbSize := sizeOf(rCF);

   // Gets the format of the selected text.
   // if third parameter = 0 then default char format is returned
   // if third parameter = 1 then selected char format is returned
   SendMessage(hWin, EM_GETCHARFORMAT, 1, LPARAM(@rCF));

   lfItalic    :=ord((rCF.dwEffects and CFE_ITALIC) <> 0);
   lfUnderline :=ord((rCF.dwEffects and CFE_UNDERLINE) <> 0);
   lfStrikeOut :=ord((rCF.dwEffects and CFE_STRIKEOUT) <> 0);

   // a value between 0 and 1000
   // 400 is normal
   // 700 is bold
   lfWeight    :=400 + 300*ord((rCF.dwEffects and CFE_BOLD) <> 0);

   lfHeight :=-rCF.yHeight div 20;

   lfCharSet        :=rCF.bCharSet;
   lfPitchAndFamily :=rCF.bPitchAndFamily;
   StrCopy(lfFaceName, rCF.szFaceName);
   end; // with TheLogFont do begin

with ChooseFontRec do begin
   lStructSize    := SizeOf(ChooseFontRec);
   hwndOwner      := hParent;
   hDC            := 0;
   lpLogFont      := @TheLogFont;
   iPointSize     := 0;  // in 1/10th of a point
   Flags          := CF_INITTOLOGFONTSTRUCT or CF_SCREENFONTS or CF_EFFECTS;
   rgbColors      := rCF.crTextColor;
   lCustData      := 0;
   lpfnHook       := nil;
   lpTemplateName := nil;
   hInstance      := 0;
   lpszStyle      := nil;
   nFontType      := 0;
   nSizeMin       := 0;
   nSizeMax       := 0;

   // in 1/10th of a point   in -1/10th of a point ???
 //  iPointSize                :=-rCF.yHeight div 10;
   // Height of the characters. in which units ? Maybe in twips.
   //  1 twip   = 1 / 1440  Inches = 1 / 20 points
   //  1 point  = 1 /   72  Inches
   // 12 points = 1 /    6  Inches = 0.42 cm. It is a usual character height for printed text.
   //  1 Inch   = 2.54 cm.
   end; // with ChooseFontRec do begin

if ChooseFont(@ChooseFontRec) then begin
   DeleteObject(TheFont);
   TheColor := ChooseFontRec.rgbColors;
   TheFont  := CreateFontIndirect(@TheLogFont);
//   SendMessage(hWin,WM_SETFONT,TheFont,1);  not usefull

   // need the Device Context of the RichText control, to set the righ char height
//   hDCWin:=GetDC(hWin);

   with rCF do begin
      cbSize := sizeOf(rCF);
      // allow different attribute to be taken into account.
      dwMask          :=CFM_BOLD   or CFM_COLOR     or CFM_FACE or
                        CFM_ITALIC or CFM_OFFSET    or CFM_PROTECTED or
                        CFM_SIZE   or CFM_STRIKEOUT or CFM_UNDERLINE;
      dwEffects:=0;
      if (TheLogFont.lfItalic <> 0)    then dwEffects:=dwEffects or CFE_ITALIC;
      if (TheLogFont.lfUnderline <> 0) then dwEffects:=dwEffects or CFE_UNDERLINE;
      if (TheLogFont.lfStrikeOut <> 0) then dwEffects:=dwEffects or CFE_STRIKEOUT;
      if (TheLogFont.lfWeight >= 700)  then dwEffects:=dwEffects or CFE_BOLD	;

      // convert units. I don't undertand too much
//      yHeight:=-MulDiv( TheLogFont.lfHeight,
  //                      GetDeviceCaps(hDCWin, LOGPIXELSY), 6);

      // Height of the characters. in which units ? Maybe in twips.
      //  1 twip   = 1 / 1440  Inches = 1 / 20 points
      //  1 point  = 1 /   72  Inches
      // 12 points = 1 /    6  Inches = 0.42 cm. It is a usual character height for printed text.
      //  1 Inch   = 2.54 cm.
      yHeight         :=-20 * TheLogFont.lfHeight; // convert points into twips
//      DBW0(4, 'size=' + ITS(TheLogFont.lfHeight) + ITS(yHeight));
      yOffset         :=0;
      crTextColor     :=TheColor;
      bCharSet        :=TheLogFont.lfCharSet;
      bPitchAndFamily :=TheLogFont.lfPitchAndFamily;
      StrCopy(szFaceName, TheLogFont.lfFaceName);
      end; // with rCF do begin

   // don't need the device context any more. Thus must be released.
//   ReleaseDC(hWin, hDCWin);

   // if third parameter = 0 then all text will be the same font, color, ...
   // if third param = SCF_SELECTION, then only the selection changes
   // if third param = SCF_SELECTION or SCF_WORD, then selection + word changes
   SendMessage(hWin, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@rCF));
   end;
end;  // TRichText0.SelectFont

procedure TRichText0.SelectAllText;
//=================================
// Select all text.
begin
SendMessage(hWin, EM_SETSEL,0,-1);
end;  // TRichText0.SelectAllText

procedure TRichText0.UndoText;
//============================
// Undo last action
begin
SendMessage(hWin, WM_Undo,0,0);
end;  // TRichText0.UndoText

procedure TRichText0.CutText;
//===========================
// Cut text.
begin
SendMessage(hWin, WM_Cut,0,0);
end;  // TRichText0.CutText

procedure TRichText0.CopyText;
//============================
// Copy text.
begin
SendMessage(hWin, WM_Copy,0,0);
end;  // TRichText0.Copy

procedure TRichText0.PasteText;
//=============================
// Paste text.
begin
SendMessage(hWin, WM_Paste,0,0);
end;  // TRichText0.PasteText

procedure TRichText0.AppendText(strS:ShortString);
//================================================
// Add a line of text at the end of the existing text.
begin
if (hWin = 0) then exit; // no window opened.

// add the string at the end of the text
SendMessage(hWin, em_SetSel, -1, -1);

// add return linfeed at the end of the string,
// plus #0 to indicate the end of the string
strS:=strS + #13 + #10 + #0;
SendMessage(hWin, em_ReplaceSel, 1, word32(@strS[1]));
end;  // TRichText0.AppendText

function TRichText0.GetTextLength:longint;
//========================================
// Get the length of the text in the buffer.
begin
GetTextLength:=GetWindowTextLength(hWin);
end;  // TRichText0.GetTextLength

function TRichText0.GetClipboardRichTextLength:longint;
//=====================================================
// Get the length of the text in the Clippboard.
var
  hClip       : HANDLE;  // handle on the clipboard
  lPastLen    : longint; // length of the text in the clipboard.
  lpstrLoc    : PCHAR;   // pointer on the data to past

begin
// Opens the clipboard for reading its text length
OpenClipboard(hWin);

hClip:=GetClipboardData(CF_TEXT); // handle on the clipboard. =0 if error

if (hClip = 0) then begin
   // I never got an error
   lPastLen:=GetLastError;  // Gets the error reason

   ErrorWrite( ERR_TRichText0_GetClipboardRichTextLength_1,
                  'in TRichText0.GetClipboardRichTextLength');
      ErrorComment( ERR_TRichText0_GetClipboardRichTextLength_1,
         'Error trying to receive a handle on the clippoard. (Got a nul handle)');
      ErrorComment( ERR_TRichText0_GetClipboardRichTextLength_1,
         'Error No =' + IntToStr(lPastLen, 5) + '   The text in your editor can miss some characters!');

   GetClipboardRichTextLength:=0;  // error
   exit;
   end;

// must get a pointer on the data do be pasted,
// if one want to know its size
lpstrLoc := GlobalLock(hClip);  // must lock data in the clipboard
if (lpstrLoc = NIL) then begin
   // nothing is in the clipboard
   GetClipboardRichTextLength:=0;
   exit;
   end;

// Get length of the text to past
lPastLen:=StrLen(lpstrLoc);
GlobalUnlock(hClip); // must unlock to data in the clipboard

// if (lPastLen > 1000000) then lPastLen:=1000000; // security

CloseClipboard; // let the clipboard free for other applications

GetClipboardRichTextLength:=lPastLen;

{   // Show all existing format in the clipboard.
   hClip:=0;
   repeat
      hClip:=EnumClipboardFormats(hClip);
      DBW0(64, 'Format = ' + ITS(hClip));
      until (hClip = 0); }

   // All existing
{   DBW0(64, 'CF_BITMAP = ' + ITS(CF_BITMAP));             // =  2
   DBW0(64, 'CF_DIB = ' + ITS(CF_DIB));                   // =  8
   DBW0(64, 'CF_ENHMETAFILE = ' + ITS(CF_ENHMETAFILE));   // = 14
   DBW0(64, 'CF_METAFILEPICT = ' + ITS(CF_METAFILEPICT)); // =  3
   DBW0(64, 'CF_OEMTEXT = ' + ITS(CF_OEMTEXT));           // =  7
   DBW0(64, 'CF_TEXT = ' + ITS(CF_TEXT));                 // =  1
   DBW0(64, 'CF_UNICODETEXT = ' + ITS(CF_UNICODETEXT));   // = 13  }
end;  // TRichText0.GetClipboardRichTextLength

procedure TRichText0.AutoSize(nLeft,nTop:integer; var nWidth,nHeight:int32);
//=========================================================================
// Computes the sizes automatically, if no sizes where specified.
// Gives as infor the values of nLeft and nTop
// Units are pixels
var
  rRec        : RECT;  // parent window size

begin
nLeft:=nLeft; nTop:=nTop; // to avoid hints

// Rich edit controls usually occupies all the space of the client window

// Size of the parent window
GetClientRect(hParent, @rRec);

nWidth  :=rRec.Right;
nHeight :=rRec.Bottom;

if (poStatusLine <> NIL) and
   (poStatusLine^.poParent = poParent) then begin
   // If a status line takes some room.
   nHeight := nHeight - int32(poStatusLine^.wHeight);
   end;
end;  // TRichText0.AutoSize

procedure TRichText0.CtrlCreate;
//==============================
Begin
{ use : UINT GetSystemDirectory(
             LPTSTR  lpBuffer, // address of buffer for system directory
             UINT  uSize      // size of directory buffer
             );  to know wher the system directory is.
             "C:\Windows\System" usually
}
// must load the dll handling the RichEdit control.
LoadLibrary('Riched32.dll');

// must be called before the RichEdit window is created. not sure ???
// InitCommonControls;

// If there is a status line, the height is lower.
// But the status line must belong to the window,
// i.e. have the same parent as the rich edit control.
// which is not the case with MDI child windows
if (poStatusLine <> NIL) and
   (poStatusLine^.poParent = poParent) then begin
   nYSizePix:=nYSizePix - int32(poStatusLine^.wHeight);
   end;

// Create the Edit control
inherited CtrlCreate; // hWin = the handle on the rich edit

If (hWin = 0) Then Begin
   // Error has already been reported in CtrlCreate.
   ErrorComment( ERR_TRichText0_RichEditCreate_1, 'Error forwarded in TRichText0.RichEditCreate');
   ErrorComment( ERR_TRichText0_RichEditCreate_1, 'Handle on a rich edit control could not be created.');
   exit;  // can't do anything more
   end;

{   //Set Courier new as default font
   with TheLogFont do  begin
      lfHeight         := 0;                // Default logical height of font
      lfWidth          := 0;                // Default logical average character width
      lfEscapement     := 0;                // angle of escapement
      lfOrientation    := 0;                // base-line orientation angle
      lfWeight         := FW_NORMAL;        // font weight
      lfItalic         := 0;                // italic attribute flag
      lfUnderline      := 0;                // underline attribute flag
      lfStrikeOut      := 0;                // strikeout attribute flag
      lfCharSet        := DEFAULT_CHARSET;  // character set identifier
      lfOutPrecision   := OUT_DEFAULT_PRECIS;  // output precision
      lfClipPrecision  := CLIP_DEFAULT_PRECIS; // clipping precision
      lfQuality        := DEFAULT_QUALITY;     // output quality
      lfPitchAndFamily := DEFAULT_PITCH;    // pitch and family
      Strcopy(lfFaceName,'Courier New');    // pointer to typeface name string
      end; // with

   TheColor := GetSysColor(COLOR_WINDOWTEXT);
   TheFont  := CreateFontIndirect(@TheLogFont);
   SendMessage(hWin, WM_SETFONT, TheFont, 1);
   end; }

// Sets the limit text size contained in the rich text control.
// by default it is 32767. Here we change the default value.
SendMessage(hWin, EM_EXLIMITTEXT, 0, lTextBufferSize);

// To specify that all events in the RichEdit control must be send to
// parent window.
// It might be easier to treat the notification messages to the parent,
// than the messages sended to the control.
SendMessage( hWin, EM_SETEVENTMASK, 0, ENM_CHANGE or ENM_CORRECTTEXT or
             ENM_DROPFILES or ENM_KEYEVENTS or ENM_PROTECTED or
             ENM_REQUESTRESIZE or ENM_SCROLL or ENM_SELCHANGE or ENM_UPDATE
             {or ENM_MOUSEEVENTS}
             );
ShowWindow(hWin, SW_Show);
End;  // TRichText0.CtrlCreate

procedure TRichText0.CtrlNotifMessageHandle(wNotif:UINT; lPar:LPARAM);
//===================================================================
// Handles the notification messages that the control sended to
// its parent. It can either come from a WM_COMMAND or from a WM_NOTIFY
// received by the parent.
var
  prMsg       : ^MSGFILTER; // info sended in an msgfilter
  lTextLen    : longint; // length of the actual text in the control buffer.

begin
// DBW0(1024, 'Rich ' + DBNotifToStr(wNotif) + ITS(lPar));

if (wNotif = EN_CHANGE) then begin
   // Editor has changed
   SetModifyState(TRUE);
   end;

if (wNotif = EN_MSGFILTER) then begin
   prMsg:=Pointer(lPar);  // original message

   // a new character was typed.
   if (prMsg^.msg = WM_CHAR) then begin
      // Test if the text buffer size is big enough.
      // if not, increase its size.
      // it is not satisfactory to do it this way, but I don't know
      // a better way.
      lTextLen:=GetWindowTextLength(hWin);

//      DBW0(1, ITS(lTextLen) + ITS(lTextBufferSize));
      // 300 is a little security
      if (lTextLen + 300 > lTextBufferSize) then begin
         // increase the text buffer size
         lTextBufferSize:=lTextBufferSize + 10000;
         SendMessage(hWin, EM_EXLIMITTEXT, 0, lTextBufferSize);
         end;
      end; // if (prMsg^.msg = WM_CHAR) then begin
   end; // if (wNotif = EN_MSGFILTER) then begin
end;  // TRichText0.CtrlNotifMessageHandle

function TRichText0.CtrlWindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT;
//============================================================================================
// handles the messages of the window control.
// A SendMessage(hWin, ...) must never be called from here, since
// it would be a calling loop
var
  lTextLen,   // actual text lenght in the buffer
  lPastLen    // length of the text in the clipboard
              : longint;

begin
{if (wMsg <> WM_MouseMove) and (wMsg <> WM_NCHitTest) and
   (wMsg <> WM_SetCursor) and (wMsg <> WM_GETTEXTLENGTH) and
//   (wMsg <> WM_SetFocus) and (wMsg <> WM_KEYUP) and
   (wMsg <> WM_NCMOUSEMOVE) and (wMsg <> WM_KillFocus) then
   DBW0(32, DBMsgToStr(wMsg) + ITS(wPar) + ITS(lPar)); }

// Call the previous window proc of a control
if (lPreviousAddress = 0) then begin
   // error, not normal
   ErrorWrite( ERR_TRichText0_CtrlWindowProc_1, 'in TRichText0.CtrlWindowProc');
      ErrorComment( ERR_TRichText0_CtrlWindowProc_1,
         'Error, previous handling address not defined !!!');
      ErrorComment( ERR_TRichText0_CtrlWindowProc_1,
         'IMPOSSIBLE Error, or programming error.');

   // By default, call DefWindowProc, but it can be wrong.
   CtrlWindowProc := DefWindowProc(hWindow, wMsg, wPar, lPar);
   exit;
   end;

if (wMsg = EM_EXLIMITTEXT) then begin
   // the text buffer size hase changed, memorise it
   lTextBufferSize:=lPar;
   end;

// Test if the richEdit control has a text buffer big enough.
// If not, increases it.
if ((wMsg = WM_KEYDOWN) and (wPar = VK_V)) or
   ((wMsg = WM_KEYDOWN) and (wPar = VK_INSERT)) or
   (wMsg = WM_PASTE) then begin
   // if wMsg = WM_PAST, got from the menu, it works.
   // if wMsg = WM_CHAR, got from the accelerator ctrl-v,
   // it is too late, the text has already been pasted.
   // ctrl-v pressed, or Past from the menu selected.
   // must test the size of the text buffer, before pasting
   // Test if the buffer size is big enough to receive the text.
   // It not, increases the text buffer size

   // length of the text in the buffer
   lTextLen:=GetTextLength; // = GetWindowTextLength(hWin);

   // length of the text in the clipboard
   lPastLen:=GetClipboardRichTextLength;

   // 300 is a little security (useless probably)
   if (lTextLen + lPastLen + 300 > lTextBufferSize) then begin
      // increase the text buffer size
      lTextBufferSize:=lTextLen + lPastLen + 10000;
      SendMessage(hWin, EM_EXLIMITTEXT, 0, lTextBufferSize);
{      DBW0(1, 'Text length = ' + ITS(lTextLen));
      DBW0(1, 'Clip. length= ' + ITS(lPastLen));
      DBW0(1, 'Buffer size = ' + ITS(lTextBufferSize));  }
      end;
   end; // if (wMsg = WM_PASTE) or ((wMsg = WM_CHAR) and (wPar = 22))

// calls the standard message processing of the richedit control
CtrlWindowProc:=CallWindowProc( WNDPROC(lPreviousAddress), hWindow,
                                wMsg, wPar, lPar);
// Sometimes it is easier to treat the notification message send
// to the parent of the control.
// These are treated in the TRichText0.CtrlNotifMessageHandle methode.
end; // TRichText0.CtrlWindowProc

End.  // unit wRichText0;

