unit wComboBox0;

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

  to facilitate to have a Check Button 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 wEditBox0, wControl0, wWindowBase0, wGlobals2, Windows;

type
  PComboBox0 = ^TComboBox0;
//  TComboBox0 = object(TControl)
  TComboBox0 = object(TEditBox0) // Try to make it inherit some procedures from the edit box.
  //"""""""""""""""""""""""""""
//  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

  lComboPreviousAddress : longint;
  // Memorise the address of the previous window message handler.

  wMsgFillNum : word32;
  // If different from zero, its a number in the message file
  // telling the combo box what are the lines which should fill it

  vYSizeOpenCh : Float;
  // Size of the compbo box when it is opened

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

  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 AddString(strS:ShortString); virtual;
  // Add a string in the Combo Box

  procedure InsertString(nIndex:int32; strS:ShortString); virtual;
  // Insert a string in the Combo Box at the specifies index.

  procedure ComboBoxFill; virtual;
  // Fill the combo box with strings being in the messages file
  // at number  wMsgFillNum.

  procedure CtrlCreate; virtual;
  // Create a combo box control window.
  // It can be easily changed to different kind of combo boxes
  // c.f. dwExStyle in the init part.

  function GetCurrentText:ShortString; virtual;
  // Gets the current text of the combo box

  procedure SetCurrentSelection(nIndex:int32); virtual;
  // Sets the current selection in the combo box.

  function GetCurrentSelection:int32; virtual;
  // Gets the current selection
  // Return CB_ERR (=-1) if no selection or error.

  procedure CtrlNotifMessageHandleFirst(wNotif:UINT; lPar:LPARAM); virtual;
  // Handle notification messages, see wControl0.pp for doc.
  // Does it before its parent receive the notification.

// Not used
//  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

  function CtrlChildWindowProcBefore(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LPARAM; virtual;
  // For the very special case of ComboBox DropDown, the edit part is
  // a child of the button, and thus receives its own messages,
  // not received in CtrlWindowProc.
  // This methode handles the window messages received by the edit part.
  // It can be overriden, but handels normally what it should.
  // It is called before the default handler.
  // If it returns zero, the default handler is not called,
  // and returns zero

  procedure CtrlChildWindowProcAfter(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM); virtual;
  // For the very special case of ComboBox DropDown, the edit part is
  // a child of the button, and thus receives its own messages,
  // not received in CtrlWindowProc.
  // This methode handles the window messages received by the edit part.
  // It can be overriden, but handels normally what it should.
  // For this spacial case, the default handler is called before and
  // determines what is the returned value a message handler must return.

  end; // TComboBox0 = object(TControl)
  TComboBox =  TComboBox0;
  PComboBox = ^TComboBox;

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

Uses wMessages2, wVariableNumLink2, wErrors2, wDebug0;

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

Function MainComboWindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; stdcall; export;
//======================================================================================================
// This is the message handler function, for the edit part of a
// Combo DropDown.
var
  // corresponding object control
  poCombo      : PComboBox;

Begin
// Gets the adress of the object corresponding to this control.
poCombo:=Pointer(GetWindowLong(hWindow, GWL_USERDATA));

// If we arrived here, the pointer is correct, since it has been modified
// in the same place where the control window procedure message handling
// has been changed. This could be verified knowing that
// poCtrl^.hWin = hWindow always.

// handling before the normal handler :
if (poCombo^.CtrlChildWindowProcBefore(hWindow, wMsg, wPar, lPar) = 0) then begin
   MainComboWindowProc:=0;
   exit; // do not call the default (=norrmal) handler.
   end;

// Do the normal handling
MainComboWindowProc:=CallWindowProc( WNDPROC(poCombo^.lComboPreviousAddress),
                                     hWindow, wMsg, wPar, lPar);

// Then call the event handler of the edit part of the Combo DropDown.
poCombo^.CtrlChildWindowProcAfter(hWindow, wMsg, wPar, lPar);
End;  // MainComboWindowProc

//***************************************************
// TComboBox0 = object(TControl)
//***************************************************

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

// This will be set later, only for combo drop down.
lComboPreviousAddress:=0;

wMsgFillNum:=0; // nothing to be filled with yet.

wWindowType:=GGLCTE_CTRL_ComboBox;

strClassName  :='COMBOBOX';
strCtrlLabel  :='Combo 1'; // MUST be redefined in the main application
// strCtrlHint   :='';      // can be redefined in the main application

// rem :   CBS_DROPDOWN = $2;   CBS_DROPDOWNLIST = $3;
dwExStyle :=0;  // no extra styles by default
dwStyle   :=WS_VISIBLE or WS_CHILD or WS_VSCROLL
                or WS_TABSTOP
                or CBS_AUTOHSCROLL
                or CBS_DROPDOWN
//                or CBS_DROPDOWNLIST  // this is also used often.
//                or CBS_SIMPLE
//                or CBS_SORT
//                or CBS_UPPERCASE
                ;
end;  // TComboBox0.Init

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

procedure TComboBox0.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

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

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

ReleaseDC(hParent, hDCPar);

// 15 character width, 15 is arbitrary
if (nWidth <= tm.tmAveCharWidth) then nWidth:=15*tm.tmAveCharWidth;

// At least 12 lines visible
if (nHeight < tm.tmHeight) then nHeight:=14*tm.tmHeight;
end;  // TComboBox0.AutoSize

procedure TComboBox0.AddString(strS:ShortString);
//===============================================
// Add a string in the Combo Box
Begin
If (hWin = 0) Then Begin
   // The combo box window must exist before you can insert text in it.
   ErrorWriteMSG(2001203010);
   exit;  // can't do anything more
   end;

strS[length(strS)+1]:=#0;
SendMessage(hWin, CB_ADDSTRING, 0, LPARAM(@strS[1]));
End;  // TComboBox0.AddString

procedure TComboBox0.InsertString(nIndex:int32; strS:ShortString);
//================================================================
// Insert a string in the Combo Box at the specifies index.
Begin
If (hWin = 0) Then Begin
   // The combo box window must exist before you can insert text in it.
   ErrorWriteMSG(2001203020);
   exit;  // can't do anything more
   end;

strS[length(strS)+1]:=#0;
SendMessage(hWin, CB_INSERTSTRING, nIndex, LPARAM(@strS[1]));

End;  // TComboBox0.InsertString

procedure TComboBox0.ComboBoxFill;
//================================
// Fill the combo box with strings being in the messages file
// at number  wMsgFillNum.
var
  strS        : ShortString;
  wSecurity   : word;

begin
if (not ExistMsgNumber(wMsgFillNum)) then begin
   // Write an error message, and fill the list with one warning message
   Word32Field(2000000011, wMsgFillNum);
   ErrorWriteMsg(2001203050);
   AddString('???' + IntToStr(wMsgFillNum,0) + ' Not Found');
   exit;
   end;

strS:=GetMsg(msgNext);

// Fill the combo box
wSecurity:=1000;
while (strS <> '...END') and
      (Copy(strS,1,3) <> '???') and (wSecurity > 0) do begin
   // conver the string into another, if variables are coded into the string
   AddString(Interpret(strS));
   strS:=GetMsg(msgNext); // Get next string
   dec(wSecurity);
   end;
end;  // TComboBox0.ComboBoxFill

procedure TComboBox0.CtrlCreate;
//==============================
var
  hWinSubClass : HWND;
  vMemYSizeCh  : Float;

Begin
// Must give the size of the opended combo box, when it is created.
// No possibility is given to modify its height when the combo box is closed.
vMemYSizeCh:=vYSizeCh; // memorise its size when closed.
vYSizeCh:=vYSizeOpenCh;
inherited CtrlCreate;
vYSizeCh:=vMemYSizeCh;

If (hWin = 0) Then Begin
   // Error has already been reported in CtrlCreate.
   StrField(2000000001, strClassName, SizeOf(strClassName));
   StrField(2000000002, strCtrlLabel, SizeOf(strCtrlLabel));
   ErrorWriteMSG(2001203001);
   exit;  // can't do anything more
   end;

// rem :   CBS_DROPDOWN = $2;   CBS_DROPDOWNLIST = $3;
if ((dwStyle and CBS_DROPDOWNLIST) = CBS_DROPDOWNLIST) then begin
   // By default, first show the first element. If a DropDownList.
//   SendMessage(hWin, CB_SETCURSEL, 0, 0); // useless, no text has been defined in the combo
   end
else begin
   // To see by default the text in the combo box. If a DropDown.
   // If it was a drop down, will show no text.
   strCtrlLabel[length(strCtrlLabel)+1]:=#0;
   SetWindowText(hWin, @strCtrlLabel[1]);
   end;

// ComboBox DropDown are special.
// The edit part of the control is a child of the button
// The handle of the combo box is the one of the button.
// Thus many messages sended from Windows to the edit part of the
// control, are not received by the button, i.e. by the handle we got.
// Thus the sub-classing must be done on the control.
// Then some messages received by the button will be lost,
// but they are unimportant usually.
// The child ID (of the edit) is 1001.
hWinSubClass:=GetDlgItem(hWin, 1001);

//hWinSubClass:=0; // ??????? DELETE to see

if (hWinSubClass <> 0) then begin
   // The button is the parent of the edit part.
   // we capture its messages, to send the notifications messages
   // it receives to the window owning the control

   // Changes the function which handles the windows messages and
   // memorise the address of the previous function which handle the messages
   // If the return value is 0, there was an error.
   // The new handling function will never be called.
   lComboPreviousAddress:=SetWindowLong(hWinSubClass, GWL_WNDPROC,
                                        longint(@MainComboWindowProc));

   If (lComboPreviousAddress = 0) Then Begin
      StrField(2000000001, strClassName, SizeOf(strClassName));
      StrField(2000000002, strCtrlLabel, SizeOf(strCtrlLabel));
      ErrorWriteMSG(2001203002);
      exit;  // can't do anything more
      end;

   // Memorises the pointer on the object control, in the
   // control created by windows, in order to reuse it
   SetWindowLong(hWinSubClass, GWL_USERDATA, longint(@Self));
   end;

if (wMsgFillNum <> 0) then ComboBoxFill;

// Set the right selection for DropDownList combo boxes
if ((dwStyle and CBS_DROPDOWNLIST) = CBS_DROPDOWNLIST) then begin
   strCtrlLabel[length(strCtrlLabel)+1]:=#0;
   SendMessage(hWin, CB_SELECTSTRING, -1, LPARAM(@strCtrlLabel[1]));
   end;

End;  // TComboBox0.CtrlCreate

function TComboBox0.GetCurrentText:ShortString;
//=============================================
// Gets the current text of the combo box
var
  strS        : ShortString;
  nLen : integer;

Begin
{ If (hWin = 0) Then Begin
   // The combo box window must exist before you can get text in it.
   ErrorWrite( ERR_TComboBox0_GetCurrentText_1, ERRMsg_TComboBox0_GetCurrentText_1,
               'in TComboBox0.GetCurrentText');
   ErrorComment( ERR_TComboBox0_GetCurrentText_1,
     'The combo box window must exist before you can get text from it.');
   exit;  // can't do anything more
   end; }

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

procedure TComboBox0.SetCurrentSelection(nIndex:int32);
//=====================================================
// Sets the current selection in the combo box.
Begin
If (hWin = 0) Then Begin
   // The combo box window must exist before you can insert text in it.
   ErrorWriteMSG(2001203060);
   exit;  // can't do anything more
   end;

SendMessage(hWin, CB_SETCURSEL, nIndex, 0);
End;  // TComboBox0.SetCurrentSelection

function TComboBox0.GetCurrentSelection:int32;
//============================================
// Gets the current selection
// Return CB_ERR (=-1) if no selection or error.
Begin
GetCurrentSelection:=SendMessage(hWin, CB_GETCURSEL, 0, 0);
End;  // TComboBox0.GetCurrentSelection

procedure TComboBox0.CtrlNotifMessageHandleFirst(wNotif:UINT; lPar:LPARAM);
//=========================================================================
// Handles the notification messages that the control sended to
// its parent.
begin
inherited CtrlNotifMessageHandleFirst(wNotif, lPar); // For the moment (december 2001) this does nothing.
end;  // TComboBox0.CtrlNotifMessageHandleFirst
{
function TComboBox0.CtrlWindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT;
//============================================================================================
// Handles the notification messages that the control sended to
// its parent.
begin
CtrlWindowProc:=inherited CtrlWindowProc(hWindow, wMsg, wPar, lPar);
end;  // TComboBox0.CtrlWindowProc
}
function TComboBox0.CtrlChildWindowProcBefore(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LPARAM;
//=====================================================================================================
// For the very special case of ComboBox DropDown, the edit part is
// a child of the button, and thus receives its own messages,
// not received in CtrlWindowProc.
// This methode handles the window messages received by the edit part.
// It can be overriden, but handels normally what it should.
// It is called before the default handler.
// If it returns zero, the default handler is not called,
// and returns zero
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
CtrlChildWindowProcBefore:=1; // by default, use the normal handler

{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(1024, 'combo 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
   // Can refuse some characters.
   if (MaskWMChar(Char(wPar))) then begin
      // The character is refused
      CtrlChildWindowProcBefore:=0; // do not use the normal handler, thus the char is refused.
      end;
   end; // if (wMsg = WM_CHAR) then begin

hWindow:=hWindow; lPar:=lPar; // to avoid hints
end;  // TComboBox0.CtrlChildWindowProcBefore

procedure TComboBox0.CtrlChildWindowProcAfter(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM);
//===============================================================================================
// For the very special case of ComboBox DropDown, the edit part is
// a child of the button, and thus receives its own messages,
// not received in CtrlWindowProc.
// This methode handles the window messages received by the edit part.
// It can be overriden, but handels normally what it should.
// For this spacial case, the default handler is called before and
// determines what is the returned value a message handler must return.
var wRep : word;
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(32, DBMsgToStr(wMsg) + ITS(wPar) + ITS(lPar)); }


// The combo box value has changed be selecting a value in its list.
if (wMsg = WM_SETTEXT) then begin
   // Update the content of the linked variable.
   if (pVarLink <> NIL) then begin
      wRep:=UpdateVarLink;

      // 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; // if (wMsg = WM_SETTEXT) then begin

hWindow:=hWindow; lPar:=lPar; wPar:=wPar; // to avoid hints
end;  // TComboBox0.CtrlChildWindowProcAfter


End.  // unit wComboBox0;

