unit wEditBox0;

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

  to facilitate to have an EditBox in a window
  ----------------------------------------------------------------}

// 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, wGlobals0, wGlobals2, Windows;

type
  PEditBox0 = ^TEditBox0;
  TEditBox0 = 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
  TheFont     : HFont;
  TheLogFont  : TLogFont;
  TheColor    : DWORD;
  strFileName : ShortString;

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

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

  wFloatLength   : word32;
  wFloatDecimals : word32;
  // default length and number of decimals, when returning a float
  // as a string value.

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

  function SelectFile(Var strFName:ShortString; Open:Boolean): Boolean; virtual;
  procedure SaveText; virtual;
  procedure AskSave; virtual;
  procedure LoadText; virtual;
  procedure NewText; virtual;
  procedure SelectFont; virtual;

  function GetCurrentText:ShortString; virtual;
  // return the text in the edit box.

  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;
  // Creates the Edit box control window
  // Must have a parent object window, if not, nothing happens.

  procedure NotifyParentResize(fRedraw:boolean); virtual;
  // When the parent is resized (with WM_SIZE usually),
  // he must call this method to allow the control to be
  // at the right place and size

{ Defined in wControl0.pp
  function UpdateVarLink:word; virtual;
  // This changes the content of the variable linked with this control
  // Returns :
  // 0 if ok
  // 1 if overflow
  // 3 if variable didn't change
  // 4 if not valide text, for example, not valide number.
}

  procedure UpdateFromVar; virtual;
  // If the value of the linked variable changed, for example in the
  // main program, then calling this procedure will
  // change the content of the control to contain the value of the variable

  procedure CtrlNotifMessageHandle(wNotif:UINT; lPar:LPARAM); virtual;
  // Handles the window messages sended to the parent of controls
  // Normally, windows doesn't send messages to controls which can
  // be treated easilly be the user.
  // See wControl0.pp for the rest of the comments.

  function MaskWMChar(cChar:Char):boolean; virtual;
  // return FALSE if the character is accepted,
  // TRUE if the character is not accepted in the edit box

  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; // TEditBox0 = object(TControl)
  TEditBox =  TEditBox0;
  PEditBox = ^TEditBox;

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

Uses wVariableNumLink2, wErrors0, wDebug0, Strings;

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

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

wWindowType:=GGLCTE_CTRL_EDITBOX;

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

dwExStyle :=WS_EX_ClientEdge;
dwStyle   :=  WS_VISIBLE or WS_CHILD
              or ES_Left
              or WS_TABSTOP
//              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
              ;
// more properties of the editBox.
TheFont     :=0;
// TheLogFont :=  not initialised !!!
TheColor    :=0; // black
strFileName:='';

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

wFloatLength   :=15;
wFloatDecimals := 9;
end;  // TEditBox0.Init

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

Function TEditBox0.SelectFile(Var strFName:ShortString; Open:Boolean): Boolean;
//=============================================================================
Const
  Filter : PChar = 'Text files (*.txt)'#0'*.txt'#0+
                   'All files (*.*)'#0'*.*'#0#0;
  Ext    : PChar = 'txt';
Var
  NameRec : OpenFileName;
Begin
FillChar(NameRec,SizeOf(NameRec),0);
strFName := #0;
With NameRec Do Begin
   LStructSize := SizeOf(NameRec);
   HWndOwner   := hParent;
   LpStrFilter := Filter;
   LpStrFile   := @strFName[1];
   NMaxFile    := Max_Path;
   Flags       := OFN_Explorer Or OFN_HideReadOnly;
   If Open Then Begin
      Flags := Flags Or OFN_FileMustExist;
      End;

    LpStrDefExt := Ext;
  End;

If Open Then SelectFile := GetOpenFileName(@NameRec)
Else         SelectFile := GetSaveFileName(@NameRec);

// Convert null terminated string to ShortString
strFName[0]:=Char(StrLen(@strFName[1]));
End;  // TEditBox0.SelectFile

procedure TEditBox0.SaveText;
//===========================
Var
  lLen        : Longint;
  pcH         : PChar;
  fOut        : File;
  strFName    : ShortString;
Begin
If SelectFile(strFName,False) Then Begin
   Assign(fOut, strFName);
   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);
   FreeMem(pcH, lLen+1);
   strFileName:=strFName;

   if (poStatusLine <> NIL) then begin
      poStatusLine^.SetStatusText(1, strFileName);
      poStatusLine^.SetStatusText(2,'');
      end;

   SendMessage(hWin,EM_SetModify,0,0);
   End;
End;  // TEditBox0.SaveText

Procedure TEditBox0.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
      SaveText;
      End;
   End;
End;  // TEditBox0.AskSave

Procedure TEditBox0.LoadText;
//===========================
Var
  fIn         : File;
  lLen        : LongInt;
  pcH         : PChar;

Begin
AskSave;

If SelectFile(strFileName,True) Then Begin
   Assign(fIn, strFileName);
   Reset(fIn,1);
   lLen := FileSize(fIn);
   GetMem(pcH, lLen+1);
   pcH[lLen] := #0;
   If (lLen > 0) Then BlockRead(fIn, pcH^, lLen);
   Close(fIn);
   SetWindowText(hWin, pcH);
   SendMessage(hWin,EM_SetModify,0,0);
   FreeMem(pcH, lLen+1);
   if (poStatusLine <> NIL) then begin
      poStatusLine^.SetStatusText(1, strFileName);
      poStatusLine^.SetStatusText(2,'');
      end;
   End;
End;  // TEditBox0.LoadText

Procedure TEditBox0.NewText;
//==========================
Const
  Empty : PChar = '';
Begin
AskSave;
strFileName := 'Unsaved';
if (poStatusLine <> NIL) then poStatusLine^.SetStatusText(1, strFileName);
SendMessage(hWin,WM_SetText,1, LongInt(Empty));
SendMessage(hWin,EM_SetModify,0,0);
End;  // TEditBox0.NewText

procedure TEditBox0.SelectFont;
//=============================
var
  ChooseFontRec : TChooseFont;
begin
with ChooseFontRec do begin
   lStructSize    := SizeOf(ChooseFontRec);
   hwndOwner      := hParent;
   hDC            := 0;
   lpLogFont      := @TheLogFont;
   iPointSize     := 0;
   Flags          := CF_INITTOLOGFONTSTRUCT or CF_SCREENFONTS or CF_EFFECTS;
   rgbColors      := TheColor;
   lCustData      := 0;
   lpfnHook       := nil;
   lpTemplateName := nil;
   hInstance      := 0;
   lpszStyle      := nil;
   nFontType      := 0;
   nSizeMin       := 0;
   nSizeMax       := 0;
   end; // with

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

function TEditBox0.GetCurrentText:ShortString;
//============================================
// return the text in the edit box.
var
  strS : ShortString;
  nLen : integer;

begin
nLen:=GetWindowText(hWin, @strS[1], SizeOf(strS)-2);
strS[0]:=char(nLen);
GetCurrentText:=strS;
end;  // TEditBox0.GetCurrentText

procedure TEditBox0.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
  tm          : TEXTMETRIC;  // for the text width and height
  hDCPar      : HDC;
  rRec        : RECT;  // parent window size
  vXPix_Ch,   // Convertion from Char width  to pixels
  vYPix_Ch    // Convertion from Char Height to pixels
       : Float;

begin
// The edit box is the most difficult to handle.
// Three cases can be taken into account.
// 1) It is not an ES_MULTILINE, thus height = 1.5 times character size.
// 2) It is an ES_MULTILINE and (nLeft = 0) and (nTop = 0)
//    It should probably fit the entier window.
// 3) It is an ES_MULTILINE but (nLeft <> 0) or (nTop <> 0)
//    Here default values are difficult to choose.

// gets the text height and witdth of characters
// Will be used to define default sizes.
hDCPar:=GetDC(hParent);
GetTextMetrics(hDCPar, @tm);

// convertion from Ch to pix
vXPix_Ch := tm.tmAveCharWidth;
vYPix_Ch := tm.tmHeight;

ReleaseDC(hParent, hDCPar);

if ((dwStyle and ES_MULTILINE) <> ES_MULTILINE) then begin
   // it is not an ES_MULTILINE

   // 15 character large. 15 is arbitrary
   if (nWidth <= vXPix_Ch) then nWidth:=Round(15*vXPix_Ch);

   // Usual Height is 1.5 character high
   if (nHeight <= vYPix_Ch) then nHeight:=Round(1.5*vYPix_Ch);
   exit;
   end;

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

// Here it is a multi-line edit box
if (nLeft = 0) and (nTop = 0) then begin
   // The edit box takes the complete parent window size
   nWidth  :=rRec.Right;
   nHeight :=rRec.Bottom;

   // 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
      // If a status line takes some room.
      GetClientRect(poStatusLine^.hWin, @rRec);
      nHeight := nHeight - (rRec.Bottom - rRec.Top);
      end;

   exit;
   end;

// Here it is a multi-line edit box, but does is not places at left top.
// 15 character large. 15 is arbitrary
if (nWidth <= vXPix_Ch) then nWidth:=Round(15*vXPix_Ch);

// Usual Height is 4.5 character high, 4 lines, arbitrary
if (nHeight <= vYPix_Ch) then nHeight:=Round(4.5*vYPix_Ch);
end;  // TEditBox0.AutoSize

procedure TEditBox0.CtrlCreate;
//=============================
Var
  rRec        : TRect;
  nStatH      : int32;

Begin
nStatH:=0;

// 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
   GetClientRect(poStatusLine^.hWin, @rRec);
   nStatH := rRec.Bottom - rRec.Top;
   end;

if (pVarLink <> NIL) then begin
   // a variable is linked to this control.
   // Define the content of the edit box
   strCtrlLabel:=ValueOf( pVarLink, rVarLinkInfo.wVarType,
                          wFloatLength, wFloatDecimals);
   end;

// Create the Edit control
nYSizePix:=nYSizePix - nStatH;
inherited CtrlCreate; // hWin = the handle on the edit box
nYSizePix:=nYSizePix + nStatH;

If (hWin = 0) Then Begin
   // Error has already been reported in CtrlCreate.
   ErrorComment( ERR_TEditBox0_EditCreate_1, 'Error forwarded in TEditBox0.EditCreate');
   ErrorComment( ERR_TEditBox0_EditCreate_1, 'Handle on 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);
}

ShowWindow(hWin, SW_Show);
// UpdateWindow(hWin); // to be sure it is painted.
End;  // TEditBox0.CtrlCreate

procedure TEditBox0.NotifyParentResize(fRedraw:boolean);
//======================================================
// When the parent is resized (with WM_SIZE usually),
// he must call this method to allow the control to be
// at the right place and size
Var
  rRec        : TRect;
  nStatH      : int32;

Begin
nStatH:=0;

// 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
   GetClientRect(poStatusLine^.hWin, @rRec);
   nStatH := rRec.Bottom - rRec.Top;
   end;

// Create the Edit control
nYSizePix:=nYSizePix - nStatH;
inherited NotifyParentResize(fRedraw);
nYSizePix:=nYSizePix + nStatH;
end;  // TEditBox0.NotifyParentResize

procedure TEditBox0.UpdateFromVar;
//================================
// If the value of the linked variable changed, for example in the
// main program, then calling this procedure will
// change the content of the control to contain the value of the variable
var
  strS        : ShortString;
  wStartSel   : word32;
  wEndSel     : word32;

begin
if (pVarLink <> NIL) then begin
   // a variable is linked to this control.
   // Define the content of the edit box

   // Where is the caret (=blinking cursor
   SendMessage(hWin, em_GetSel, WPARAM(@wStartSel), LPARAM(@wEndSel));

   strS:=ValueOf( pVarLink, rVarLinkInfo.wVarType, wFloatLength, wFloatDecimals);
   strS[length(strS)+1]:=#0;
   SetWindowText(hWin, @strS[1]);

   // Set back the selection and caret position
   SendMessage(hWin, em_SetSel, wStartSel, wEndSel);
   end;

end;  // TEditBox0.UpdateFromVar

procedure TEditBox0.CtrlNotifMessageHandle(wNotif:UINT; lPar:LPARAM);
//===================================================================
var wRep : word;
begin
lPar   :=lPar; // to remove a Hint

// DBW0(8192, DBNotifToStr(wNotif) + ITS(lPar));

if (wNotif = EN_CHANGE) or
   (wNotif = CBN_EDITCHANGE) or
   ((wNotif = CBN_SELCHANGE) and
    ((dwStyle and CBS_DROPDOWNLIST) = CBS_DROPDOWNLIST)) then begin
   // Update the content of the linked variable.
   if (pVarLink <> NIL) then begin
      wRep:=UpdateVarLink; // wRep = 4 if not accepted.

      // Notify the grand parent, i.e. the window owning the dialog box usually,
      // that the content of the the associated of the edit box changed
      // Notify only if the variable really changed its value.
     if (wRep <> 4) and (wRep <> 3) then begin
        if    (poGrParent <> NIL) then poGrParent^.CtrlVarUpdate(@Self, pVarLink)
        else if (poParent <> NIL) then poParent^.CtrlVarUpdate(@Self, pVarLink);
        end;
     end;
   end;
// inherited ... not usefull, since the parent does nothing.

end;  // TEditBox0.CtrlNotifMessageHandle

function TEditBox0.MaskWMChar(cChar:Char):boolean;
//================================================
// return FALSE if the character is accepted,
// TRUE if the character is not accepted in the edit box
begin
MaskWMChar:=FALSE; // by default, don't mask the input character.

if (pVarLink = NIL) then exit;

if (rVarLinkInfo.wVarType = vt_ShortString) or
   (rVarLinkInfo.wVarType = vt_Char) then exit;

if (rVarLinkInfo.wVarType >= vt_Byte) and
   (rVarLinkInfo.wVarType <= vt_Float) then begin
   // control key and number are accepted, but not the space.
   if (cChar < ' ') then exit;

   if (cChar >= '0') and (cChar <= '9') then exit;

   // numbers on the keypad are accepted
//   if (wPar >= VK_NUMPAD0) and (wPar <= VK_NUMPAD9) then exit;

   // minus signe before signed integers are allowed.
   if (cChar = '-') and
      (rVarLinkInfo.wVarType >= vt_Integer) and
      (rVarLinkInfo.wVarType <= vt_Float) then exit;

//if ((wPar = VK_DECIMAL) or (wPar = $BE)) then DBW(1, 'vk_DEC=' + ITS(wPar));

   // the decimal dot is accepted for Float numbers
   if (cChar = '.') and
      (rVarLinkInfo.wVarType >= vt_FloatS) and
      (rVarLinkInfo.wVarType <= vt_Float) then exit;

   // all other keys are refused.
   MaskWMChar:=TRUE;
   MessageBeep(0);
//DBW0(1, 'Refused Key = ' + ITS(wPar));
   exit;
   end; // if (rVarLinkInfo.wVarType >= vt_Byte) and

end;  // TEditBox0.MaskWMChar

function TEditBox0.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
const
  // statring and ending selection in the edit box
  wStartSel : word32 = 0;
  wEndSel   : word32 = 0;
  fInserting : boolean = FALSE; // is text being inserted ?
  strMemoriseText : ShortString = '';
  // To memorise very temporarly the text in the edit box,
  // to veriry some messages later, if it is a valid text
  // for the kind of variable associated with the edit box.
  // For example, if a number is associated with the exit box,
  // then the text should correspond to a valid number.
var
  nLen        : integer;
begin
{ 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_SetFocus) and (wMsg <> WM_KillFocus) and
//   (wMsg <> WM_KEYDOWN) and (wMsg <> WM_KEYUP) and
   (wMsg <> WM_Move)        and (wMsg <> WM_NCActivate) then
   DBW0(2048, 'EditBox Before :' + DBMsgToStr(wMsg) + ITS(wPar) + ITS(lPar)); }

if (wMsg = WM_KEYDOWN) and
   ((wPar = VK_INSERT) or (wPar = VK_V)) and
   (not fInserting) then begin
   // If we try to past text in the edit box,
   // 1) Memorise the actual text.
   // 2) Accept the past.
   // 3) in WM_KEYUP Test if the content is valid (ex. is a valid number
   // 4) If not, put back the memorised text.

   // Where is the caret (=blinking cursor
   SendMessage(hWindow, em_GetSel, WPARAM(@wStartSel), LPARAM(@wEndSel));

   // 1) Memorise the actual text.
   nLen:=GetWindowText(hWindow, @strMemoriseText[1], SizeOf(strMemoriseText)-2);
   strMemoriseText[0]:=char(nLen);

   // indicate that a PAST has been tried.
   fInserting:=TRUE;
   end;

if (wMsg = WM_KEYUP) and
   ((wPar = VK_INSERT) or (wPar = VK_V)) then begin
   // WM_KEYUP, after WM_PASTE, juste after WM_CHAR, just after WM_KEYDOWN

   // In case of past, must test if we accept the past.
   if fInserting then begin
       if (UpdateVarLink = 4) then begin
          // text not accepted.

          // put back the original text
          SetWindowText(hWindow, @strMemoriseText[1]);

          // Set back the selection and caret position
          SendMessage(hWindow, em_SetSel, wStartSel, wEndSel);
          end;

      strMemoriseText:=''; // empty the memorised text.
      fInserting:=FALSE;     // PASTE has been treated.
      end;
   end; // if (wMsg = WM_PASTE) then begin

if (wMsg = WM_CHAR) then begin
   // WM_CHAR comes just after WM_KEYDOWN
   // Can refuse some characters.
   if (MaskWMChar(Char(wPar))) then CtrlWindowProc:=0 // message processed, key masked
   else begin
      CtrlWindowProc:=inherited CtrlWindowProc(hWindow, wMsg, wPar, lPar);
      end;

   if (poStatusLine <> NIL) then begin
      // Editor has changed
      // If (SendMessage(hWin, EM_GetModify, 0, 0) <> 0) then
      // A SendMessage(hWin, ...) should not be called from here, since
      // it would be a calling loop
      poStatusLine^.SetStatusText(2,strStatusModifiedText);
      // This might be to specific of an application. !!!! ?????
      end;
   end // if (wMsg = WM_CHAR) then begin
else CtrlWindowProc:=inherited CtrlWindowProc(hWindow, wMsg, wPar, lPar);

end; // TEditBox0.CtrlWindowProc

End.  // unit wEditBox0;

