unit wControl0;

{ Feel free to use this unit as you want.
  First developped by Bernard Gisin
  This unit uses object programming to simplify the developpment
  of programs.

  This is the parent of every control, and helps handling controls like
  status lines, edit box, rich edit, etc.

  Examples will be given in tEx01?.pp

----------------------------------}

// 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  wWindowBase0, wVariableNumLink2, wGlobals2, windows;

type
  // To memorise in the same place of memory,
  // variables of different kind of type
  // Except for Complex and strings,
  // variable content are saved without the need of allocating memory
  RVariantVariable = record
    case wVarType : word of
      vt_Boolean : (fff : boolean);
      vt_Char    : (ccc : char);
      vt_Byte    : (bbb : byte);
      vt_Integer : (nnn : integer);
      vt_Int16   : (n16 : int16);
      vt_Int32   : (n32 : int32);
      vt_word    : (www : word);
      vt_word16  : (w16 : word16);
      vt_word32  : (w32 : word32);
      vt_FloatS  : (vss : FloatS);
      vt_Float   : (vvv : Float);
  //  vt_ComplexS
      vt_Complex : (pzz : ^Complex; wSizeComplex:word);
      vt_ShortString : (pstr : ^ShortString; wStrMaxLen:word);
         // wStrMaxLen is the maximum length the string can have, i.e.
         // One less than the space occupied by the string in memory.
         // It should be assigned a value at the same time
         // when pstr gets its value.
      end;

  PControl0 = ^TControl0;
  TControl0 = object(TWindowBase)
  //"""""""""""""""""""""""""""""
  // Handle on the window. (=0 when not created)
//  hWin     : HWND;  // Handle on the window, got from TWindowBase
//  hParent : HWND;  // Handle on the parent, got from TWindowBase
//  poParent: PWindowBase0;  // Pointer on the parent, got from TWindowBase

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

  // To define the position of the control in the parent window
  // ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  vXPosRel,  // in [0..1], relative X position in parent window, 0 = Left, 1 = Right
  vYPosRel,  // in [0..1], relative Y position in parent window, 0 = Top , 1 = Bottom
  vXPosMM,   // X position in milimeters in the parent window, = 0 if not used
  vYPosMM,   // Y position in milimeters in the parent window, = 0 if not used
  vXPosCh,   // X position in character medium width.
  vYPosCh,   // Y position in character max. height.

  vXSizeRel,  // in [0..1], relative X size, 0 = size independent of the parent
  vYSizeRel,  // in [0..1], relative Y size, 1 = the same size as the parent
  vXSizeMM,   // X size in milimeters, = 0 if not used
  vYSizeMM,   // Y size in milimeters, = 0 if not used
  vXSizeCh,   // X size in character medium width.
  vYSizeCh,   // Y sizein character max. height.

  // The positions and sizes will be added to define the final size.
  // Normally you don't mix the different units MM + Pix + Ch,
  // but you could want to add just one or two pixels to a size.
  // The units "Ch" are very convenient for texts.

  // Defines which point of the control is taken as the origine
  // 0 = Left or Top;  1 = Right or Bottom;  0.5 = Middle;
  // 0.3 = 30% from Left or Top = 70% from Right or Bottom
  vXPosCtrlRef, // X reference in [0..1]
  vYPosCtrlRef, // Y reference in [0..1]

  // Defines which point of the parent window is take as the origine
  // 0 = Left or Top;  1 = Right or Bottom;  0.5 = Middle;
  // 0.3 = 30% from Left or Top = 70% from Right or Bottom
  vXPosParentRef, // X reference in [0..1]
  vYPosParentRef // Y reference in [0..1]
              : Float;

  // positions and sizes in pixels are integers
  nXPosPix,  // X position in pixels in the parent window, = 0 if not used
  nYPosPix,  // Y position in pixels in the parent window, = 0 if not used
  nXSizePix,  // X size in pixels, = 0 if not used
  nYSizePix,  // Y size in pixels, = 0 if not used
  nXSizeMinPix,  // Minimal X size in pixels, = 10 by default, must be >= 1
  nYSizeMinPix   // Minimal Y size in pixels, = 10 by default, must be >= 1
               : int32;

  // To remember the position in pixels after the last displacement of the
  // control's window.
  nXPosLeftLast,
  nYPosTopLast,
  nWidthLast,
  nHeightLast : int32;

  // will be redefined in the descendents.
  strClassName : string[ 12]; // Class name of the control.
  strCtrlLabel : string[120]; // Text label associated with the control.
  strCtrlHint  : string[120]; // Text hint associated with the control.

  wCtrlID     : word32;
  // Identificator of the control. Should be redefined in the main application.

  pParam : pointer;
  // Parameter used when creating the control window. = NIL usually.

  dwExStyle, // extended style, redefined in the descendents
  dwStyle    // style of the control, redefined in the descendents.
     : word32;

  vPixX_MM, vPixY_MM  : Float;
  // To convert milimeters in pixels. Defined at initialisation.
  // vXPixel := vXMM * vPixX_MM;  vYPixel := vYMM * vPixY_MM;

  poGrParent : PWindowBase;
  // Pointer on the grand parent, if it has any.
  // if the control is in a dialog box, owned by a window,
  // it points to that window object.

  pVarLink    : pointer;
  // if a variable is linked to this control,
  // points to this variable.
  // With this, if the control's content changes,
  // the variable's value changes too.

  rVarLinkInfo : RVariantVariable;
  // To memorise the Type of the variable, and
  // memorise here the value of the linked variable, at creation
  // of the control's window.

  wAcceptQuit : Word32;
  // If this value is set to zero, then the control will refuse to
  // loose its focus, and also to quite the dialog box.
  // Each time the control is about to loose its focus,
  // it will reset this value to 1 and call its grand parent
  // CtrlLooseFocus(@Self, wAcceptQuit)  method, who can
  // modify this value (to 0) to  refuse to loose the focus, or to quit.
  // But quitting with CANCEL (=ESC) is always possible.

  msgMenuPopup : word32;
  // if non zero, indicates a popup menu in the message file
  // which should be opened if contextual menu is wanted
  // by clicking with the right button.
  // = 0 by default

  msgPopupWindowHelp : word32;
  // When a menu with number ID 65530 is selected, then by default,
  // the main window which receive a WM_COMMAND with this menu number
  // will call the methode  ShowPopupWindowHelp  of the
  // active control. This methode will show a popup Help Window
  // with the text corresponding to this number in the .msg file.

  msgDialogHelp : word32;
  // When a menu with number ID 65531 is selected, then by default,
  // the main window which receive a WM_COMMAND with this menu number
  // will call the methode  ShowDialogHelp  of the
  // active control. This methode will show a popup Help Window
  // with the text corresponding to this number in the .msg file.

  constructor Init(poParentW:PWindowBase0);
  // Call Init; at the beggining of a new Init constructor.

  destructor  Done; virtual;
  // Call Done; at the end of a new destructor.

  procedure Redraw; virtual;
  // Redraws the control

  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 ComputePixPosSizes(var nXPos,nYPos,nWidth,nHeight:int32); virtual;
  // Computes the positions and sizes in pixels of the control

  procedure CtrlCreate; virtual;
  // Create the window of the control.
  // Must have a parent object window, if not, nothing happens.
  // See wWindowBase0.WindowDestroy to destroy a control

  procedure GetScreenPosSize(var nXPosV,nYPosV,nWidthV,nHeightV:Int32); virtual;
  // Return the position relative to the screen of the control,
  // and its size. All in pixels unit.

  procedure RestoreVarLink; virtual;
  // if a variable was linked to this control, then its content was saved.
  // Copy back the saved value to the variable

  function UpdateVarLink:word; virtual;
  // This changes the content of the variable linked with this control
  // Returns :
  // 0 if ok
  // 1 if overflow
  // 3 if nothing changed. i.e. the variable has the same value as before.
  // 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
  // It will be overriden by descendent.
  // By default, does nothing.

  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

  procedure NotifyChanges; virtual;
  // When the button caption, ID, position or size changes,
  // this method must be called for the changes to be effectif.
  // It is not necessary for if the Hint changes.

  procedure ShowPopupWindowHelp; virtual;
  // if a popup window containing help information must be shown,
  // at current mous position, call this methode.

  procedure ShowDialogHelp; virtual;
  // Ff a Dialog (usually containing help information) must be shown,
  // call this methode.

  function CtrlWMCTLCOLOR(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;
  // Special case where controls colors can be defines by their parent.
  // The controls can define the colors directly through this call.
  // lPar = handle on the control who wants to be redrawn
  // wPar = Device context used to draw the control.
  // It can be redefined by a descentent. In this case, the
  // inherited method is not called.

  procedure NotifyEndDialogFromDialog(poParentP:PWindowBase; nReturnValueP:int32); virtual;
  // The dialog is notifying all its children that it is about to end
  // with the return value = nReturnValue
  // If it is IDCANCEL, the original values must be restored.

  procedure WMFromParent(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM); virtual;
  // Messages sent from a parent to all its children.

  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.
  // But the library simplifies the message treatment in two ways.
  // first, all messages sended to a control are captured in the
  //    CtrlWindowProc method.
  // Second, notification messages are resend from the parent to
  //    the (child) control in this method.
  // Thus it is the control who can process all messages corresponding to him.
  // This can come from a WM_COMMAND or from a WM_NOTIFY received by the parent
  // It does nothing here, but can be overriden by each descendent.
  // wNotif is the notification code, such as  EN_xxx  and  NM_xxx  and ...
  // lPar is the lPar received by the parent in the  WinProc  method

  procedure CtrlNotifMessageHandleFirst(wNotif:UINT; lPar:LPARAM); virtual;
  // Same as CtrlNotifMessageHandle, but received before its parent.

  procedure DrawHint(hWinHint:HWND); virtual;
  // Draws the Hint. hWinHint = the handle on the Hint window

  function CtrlWindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;
  // Handles the window messages
  // A SendMessage(hWin, ...) must not be called from here,
  // to avoid calling loops. (SendMessage(hWin...) calls this function

  private
  procedure WMTimer(wTimerID:WParam); // not virtual, to avoid overriding errors
  // To handle timer events.
  // used to show hints.

  end; // TControl0 = object(TWindowBase)
  TControl =  TControl0;
  PControl = ^TControl;

const
  gglpoActiveControl : PControl = NIL;
  // Points to the active control

  gglpoControlOwnerMenu : PControl = NIL;
  // Points to the control which generated the popup menu.

// Used in descendent control, such as wRichText0.pp
Function MainCtrlWindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; stdcall; export;
//======================================================================================================
// This is the message handle function, which calls the
// Control  'CtrlWindowProc' function

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

uses wMenus0, wPopupWindow0, wParamApplic2, wErrors0, wDialogCreatorLOW2,
     wObjectCreatorLOW2, wDebug0;

var glnNotUsed : integer; // To avoid an error in the DevPascal 1.9 environment

// Some global variables, to show the Hint popup window
const
  TIMER_HINT_ID = 64958; // any number identifying the timer.
  glwTimer    : word32 = 0;
  glnCpt      : integer = 0;
  glhWinHint  : HWND = 0;

var
  glnLastAdr : word32;

Function MainCtrlWindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; stdcall; export;
//======================================================================================================
// This is the message handle function, which calls the
// Control  'CtrlWindowProc' function
var
  // corresponding object control
  poCtrl      : PControl0;

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

gglpoActiveControl:=poCtrl;

// 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.
// Thus call the event handler of the object.
MainCtrlWindowProc:=poCtrl^.CtrlWindowProc(hWindow, wMsg, wPar, lPar);
End;  // MainCtrlWindowProc

//***************************************************
// TControl0 = object(TWindowBase)
//***************************************************

constructor TControl0.Init(poParentW:PWindowBase0);
//=================================================
var
  hDCLoc      : HDC; // Device context of the screen
  nHSize,     // Width, in millimeters, of the physical screen.
  nVSize,     // Height, in millimeters, of the physical screen.
  nHRes,      // Width, in pixels, of the screen.
  nVRes       // Height, in raster lines, of the screen.
     : word32;

begin
inherited Init(poParentW);

// add the control to the parent's child list.
if (poParent <> NIL) then poParent^.AddChildObjectWindow(@Self);

// This will be set by a descendent.
lPreviousAddress:=0;

// The positions and sizes will be added to define the final size.
vXPosRel   := 0;   // some default values
vYPosRel   := 0;
vXPosMM    := 0;
vYPosMM    := 0;
nXPosPix   := 0;
nYPosPix   := 0;
vXPosCh    := 0;
vYPosCh    := 0;

vXSizeRel  := 0; // 0 => X size is independent of the parent size
vYSizeRel  := 0; // 0 => Y size is independent of the parent size
vXSizeMM   := 0;
vYSizeMM   := 0;
nXSizePix  := 0;
nYSizePix  := 0;
vXSizeCh   := 0;
vYSizeCh   := 0;

// Minimum sizes
nXSizeMinPix :=5;
nYSizeMinPix :=5;

// Defines which point of the control is taken as the origine
// vXPosCtrlRef :=1; // Position relative to the Right  of the control
// vYPosCtrlRef :=1; // Position relative to the Bottom of the control
vXPosCtrlRef :=0; // Position relative to the Left of the control
vYPosCtrlRef :=0; // Position relative to the Top  of the control

// Defines which point of the parent window is take as the origine
// vXPosParentRef :=1; // Position relative to the Right  of the parent window
// vYPosParentRef :=1; // Position relative to the Bottom of the parent window
vXPosParentRef :=0; // Position relative to the Left of the parent window
vYPosParentRef :=0; // Position relative to the Top  of the parent window

// The values will be set at the next resize of the control's window
nXPosLeftLast :=0;
nYPosTopLast  :=0;
nWidthLast    :=0;
nHeightLast   :=0;

// will be redefined in the descendents.
strClassName  :='NONE'; // The class name MUST be redefined in the descendent
strCtrlLabel  :='CtrlLabel'; // MUST be redefined in the descendent
strCtrlHint   :=''; // no hints by default.
wCtrlID :=0; // should be redefined in the main application

pParam := NIL;  // no supplementary parameters by default.

// must be redefined in the descendent
dwExStyle :=0;  // no extra styles by default, modified in the descendent
dwStyle   :=  WS_VISIBLE or WS_CHILD;  // minimal styles, modified in the descendent

// Resolution in pixels / milimeters, default values in case of errors
vPixX_MM:=3.4;
vPixY_MM:=3.4;

// By default, no variable is linked to this control.
pVarLink:=NIL;
rVarLinkInfo.wVarType:=0;  // no backup made.
rVarLinkInfo.vvv:=0;       // sets the memory to zero, as a security
rVarLinkInfo.pstr:=NIL;    // should be useless
rVarLinkInfo.wStrMaxLen:=0;// should be useless
poGrParent:=NIL;
wAcceptQuit:=1;  // accept to quit.

msgMenuPopup:=0;
msgPopupWindowHelp:=0;
msgDialogHelp:=0;

// Gets the device context of the complete screen
hDCLoc:=GetDC(0);

If (hDCLoc = 0) then begin
   ErrorWrite( ERR_TControl0_Init_1, 'in TControl0.Init');
   ErrorComment( ERR_TControl0_Init_1,
                 'IMPOSSIBLE, The GetDC(0) gave a zero handle.');
   end
else begin
   // resolution of the screen
   nHSize :=GetDeviceCaps(hDCLoc, HORZSIZE); // in MM
   nVSize :=GetDeviceCaps(hDCLoc, VERTSIZE);
   nHRes  :=GetDeviceCaps(hDCLoc, HORZRES);  // in pixels
   nVRes  :=GetDeviceCaps(hDCLoc, VERTRES);

   if (nHSize <= 0) or (nVSize <= 0) then begin
      ErrorWrite( ERR_TControl0_Init_2, 'in TControl0.Init');
      ErrorComment( ERR_TControl0_Init_2,
                    'IMPOSSIBLE, Resolution in milimeters <= 0.');
      end
   else if (nHRes <= 0) or (nVRes <= 0) then begin
      ErrorWrite( ERR_TControl0_Init_3, 'in TControl0.Init');
      ErrorComment( ERR_TControl0_Init_3,
                    'IMPOSSIBLE, Resolution in pixels <= 0.');
      end
   else begin // Normal case
      // Resolution in pixels / milimeters
      vPixX_MM:=Float(nHRes) / nHSize;
      vPixY_MM:=Float(nVRes) / nVSize;
      end;
   end;

ReleaseDC(0, hDCLoc);
end;  // TControl0.Init

destructor TControl0.Done;
//========================
begin
// if a variable was linked and memoriy allocated, release this memory.
// No type checking is possible. !!!
if (rVarLinkInfo.wVarType = vt_ShortString) then dispose(rVarLinkInfo.pstr);
if (rVarLinkInfo.wVarType = vt_Complex    ) then dispose(rVarLinkInfo.pzz);

pVarLink:=NIL;
rVarLinkInfo.wVarType:=0;

// If the active control is destroyed, then no more active control.
if (gglpoActiveControl = @Self) then gglpoActiveControl:=NIL;

inherited Done;
end;  // TControl0.Done

procedure TControl0.Redraw;
//=========================
var rRec : RECT;
begin
GetClientRect(hWin, @rRec);
InvalidateRect(hWin, rRec, TRUE);
end;  // TControl0.Redraw

procedure TControl0.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
begin
// is usually redefined in the descendent.
nWidth:=nWidth;  nHeight:=nHeight;  // to avoid hints
nLeft:=nLeft;  nTop:=nTop;  // to avoid hints
end;  // TControl0.AutoSize

procedure TControl0.ComputePixPosSizes(var nXPos,nYPos,nWidth,nHeight:int32);
//===========================================================================
// Computes the positions and sizes in pixels of the control
Var
  rRec        : TRect;
  // First computes the positions in Float
  vXPosLeft, vYPosTop,  // position in pixels computed from the position given
  vXPosRight, vYPosBottom,
  vWidth,     // in the control property.
  vHeight,
  vXPix_Ch,   // Convertion from Char width  to pixels
  vYPix_Ch    // Convertion from Char Height to pixels
       : Float;

  // Then converts it in interger
  nXPosLeft, nYPosTop,  // position in pixels computed from the position given
  nXPosRight, nYPosBottom,
  nParWidth,
  nParHeight
              : int32;
  tm          : TEXTMETRIC;  // for the text width and height
  hDCPar      : HDC;

Begin // TControl0.ComputePixPosSizes
if (hParent <> 0) then begin
   // Gets the client window size of the parent window
   GetClientRect(hParent, @rRec);

   // gets the text height and witdth
   hDCPar:=GetDC(hParent);
   GetTextMetrics(hDCPar, @tm);

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

   ReleaseDC(hParent, hDCPar);
   end
else begin
   // not normal to come here.
   rRec.Left:=0;   rRec.Top:=0;   rRec.Right:=0;   rRec.Bottom:=0;
   vXPix_Ch := 7;
   vYPix_Ch := 16; // default vlues
   end;

nParWidth  := rRec.Right  - rRec.Left;
nParHeight := rRec.Bottom - rRec.Top;

// compute the position and size of the control.
vXPosLeft  :=nXPosPix  + vXPosMM  * vPixX_MM + vXPosCh  * vXPix_Ch
                       + vXPosRel  * nParWidth;
vYPosTop   :=nYPosPix  + vYPosMM  * vPixY_MM + vYPosCh  * vYPix_Ch
                       + vYPosRel  * nParHeight;
vWidth     :=nXSizePix + vXSizeMM * vPixX_MM + vXSizeCh * vXPix_Ch
                        + vXSizeRel * nParWidth;
vHeight    :=nYSizePix + vYSizeMM * vPixY_MM + vYSizeCh * vYPix_Ch
                       + vYSizeRel * nParHeight;

// position relative to the reference points.
vXPosLeft :=vXPosLeft + vXPosParentRef * nParWidth  - vXPosCtrlRef * vWidth;
vYPosTop  :=vYPosTop  + vYPosParentRef * nParHeight - vYPosCtrlRef * vHeight;

// Security to avoid overflow
if (vXPosLeft < -10000) then vXPosLeft :=-10000;
if (vXPosLeft >  10000) then vXPosLeft := 10000;
if (vYPosTop  < -10000) then vYPosTop  :=-10000;
if (vYPosTop  >  10000) then vYPosTop  := 10000;
if (vWidth    < -10000) then vWidth    :=-10000;
if (vWidth    >  10000) then vWidth    := 10000;
if (vHeight   < -10000) then vHeight   :=-10000;
if (vHeight   >  10000) then vHeight   := 10000;

// Converts in integer
nWidth :=Round(vWidth);
nHeight:=Round(vHeight);

// If no sizes where specified,
// they are computed automatically
if (nWidth  < nXSizeMinPix) or (nHeight < nYSizeMinPix) then
   AutoSize(Round(vXPosLeft), Round(vYPosTop), nWidth, nHeight);

// must really have a minimal size
if (nWidth  < nXSizeMinPix) then nWidth :=nXSizeMinPix;
if (nWidth  <            1) then nWidth :=1;
if (nHeight < nYSizeMinPix) then nHeight:=nYSizeMinPix;
if (nHeight <            1) then nHeight:=1;

// To be at the pixel precision
if (vXPosCtrlRef > 0.5) then begin
   vXPosRight  :=vXPosLeft  + vWidth;
   nXPosRight  :=Round(vXPosRight);
   nXPosLeft   :=nXPosRight - nWidth;
   end
else nXPosLeft :=Round(vXPosLeft);

// To be at the pixel precision
if (vYPosCtrlRef > 0.5) then begin
   vYPosBottom :=vYPosTop  + vHeight;
   nYPosBottom :=Round(vYPosBottom);
   nYPosTop    :=nYPosBottom - nHeight;
   end
else nYPosTop  :=Round(vYPosTop);

// The return values
nXPos:=nXPosLeft;
nYPos:=nYPosTop;
end;  // TControl0.ComputePixPosSizes

procedure TControl0.CtrlCreate;
//=============================
Var
  // Then converts it in interger
  nXPosLeft, nYPosTop,  // position in pixels computed from the position given
  nWidth,        // in the control property.
  nHeight        : int32;
  fDestroyed     : boolean;
  wStyleL        : word32;

Begin // TControl0.CtrlCreate
if (poParent = NIL) or (poParent = @Self) then begin
   // If no parent then the main window is the parent and the
   // control becomes a popup window.
   poParent:=gglpoMainWindowCopy;

   // add the control to the parent's child list.
   // No... it has no real parent object ???
//   if (poParent <> NIL) then poParent^.AddChildObjectWindow(@Self);

   wStyleL:=(dwStyle and (not WS_CHILD)) or WS_POPUP;
   end
else wStyleL:=dwStyle;

if (poParent = NIL) or (poParent^.hWin = 0) then begin
   ErrorWrite( ERR_TControl0_CtrlCreate_1, 'in TControl0.CtrlCreate');
   ErrorComment( ERR_TControl0_CtrlCreate_1, 'Controls must have a valid parent.');
   ErrorComment( ERR_TControl0_CtrlCreate_1, 'Parent pointer = ' + IntToStr(word32(poParent), 0));
   if (poParent <> NIL) then
      ErrorComment( ERR_TControl0_CtrlCreate_1, 'Parent handle  = ' + IntToStr(poParent^.hWin, 0));
   ErrorComment( ERR_TControl0_CtrlCreate_1, 'ClassName = ' + strClassName);
   ErrorComment( ERR_TControl0_CtrlCreate_1, 'Label     = ' + strCtrlLabel);
   exit;  // can't do anything more
   end;

if (hWin <> 0) then begin
   // if a window is already associated with this object,
   // destroy the associated window, and write an error message
   fDestroyed:=destroyWindow(hWin);

   // if a variable was linked and memoriy allocated, release this memory.
   // No type checking is possible. !!!
   if (rVarLinkInfo.wVarType = vt_ShortString) then dispose(rVarLinkInfo.pstr);
   if (rVarLinkInfo.wVarType = vt_Complex    ) then dispose(rVarLinkInfo.pzz);

   if fDestroyed then begin
      ErrorWrite( ERR_TControl0_CtrlCreate_2, 'in TControl0.CtrlCreate');
      ErrorComment( ERR_TControl0_CtrlCreate_2, 'Control object has already an associated window.');
      ErrorComment( ERR_TControl0_CtrlCreate_2, 'The associated window is destroyed, in order to create the new one');
      ErrorComment( ERR_TControl0_CtrlCreate_2, 'ClassName = ' + strClassName);
      ErrorComment( ERR_TControl0_CtrlCreate_2, 'Label     = ' + strCtrlLabel);
      ErrorComment( ERR_TControl0_CtrlCreate_2, 'It is a Warning. The program should be corrected.');
      // then the program continues normaly.
      end;
   end;

// If a variable is linked to the control, memorise the content of the variable
if (pVarLink <> NIL) then begin
   // a variable is linked to this control.
   // make a backup of the variable's value.

   // Here no type checking is possible, thus crasches are possible
   // if the wrong type is associated with the variable  pVarLink^
   case (rVarLinkInfo.wVarType) of
      vt_Boolean  : rVarLinkInfo.fff:=boolean(pVarLink^);
      vt_Char     : rVarLinkInfo.ccc:=char(pVarLink^);
      vt_Byte     : rVarLinkInfo.bbb:=byte(pVarLink^);
      vt_Integer  : rVarLinkInfo.nnn:=integer(pVarLink^);
      vt_Int16    : rVarLinkInfo.n16:=int16(pVarLink^);
      vt_Int32    : rVarLinkInfo.n32:=int32(pVarLink^);
      vt_word     : rVarLinkInfo.www:=word(pVarLink^);
      vt_word16   : rVarLinkInfo.w16:=word16(pVarLink^);
      vt_word32   : rVarLinkInfo.w32:=word32(pVarLink^);
      vt_FloatS   : rVarLinkInfo.vss:=FloatS(pVarLink^);
      vt_Float    : rVarLinkInfo.vvv:=Float(pVarLink^);
  //  vt_ComplexS : rVarLinkInfo.fff:=(pVarLink^);
      vt_Complex  : begin
         new(rVarLinkInfo.pzz);
         rVarLinkInfo.pzz^:=Complex(pVarLink^);
         end;
     vt_ShortString : begin
         new(rVarLinkInfo.pstr);
         rVarLinkInfo.pstr^:=ShortString(pVarLink^);
         end;
      end; // case wVarLinkType of
   end; // if (pVarLink <> NIL) then begin

// Creates the control
hParent :=poParent^.hWin; // both are always the same

// Converts to pixels the position and sizes of the control
ComputePixPosSizes(nXPosLeft, nYPosTop, nWidth, nHeight);

strClassName[length(strClassName)+1]:=#0;
strCtrlLabel[length(strCtrlLabel)+1]:=#0;

hWin := CreateWindowEx ( dwExStyle, @strClassName[1], @strCtrlLabel[1],
                         wStyleL, nXPosLeft, nYPosTop, nWidth, nHeight,
                         hParent, 0, // controls don't have menus.
                         System.MainInstance, pParam);

If (hWin = 0) Then Begin
   ErrorWrite( ERR_TControl0_CtrlCreate_3, 'in TControl0.CtrlCreate');
   ErrorComment( ERR_TControl0_CtrlCreate_3, 'Handle on control could not be created,');
   ErrorComment( ERR_TControl0_CtrlCreate_3, 'ClassName = ' + strClassName);
   ErrorComment( ERR_TControl0_CtrlCreate_3, 'Label     = ' + strCtrlLabel);
   exit;  // can't do anything more
   end;

// Sets the control identifier.
SetWindowLong(hWin, GWL_ID, wCtrlID);
// SetWindowLong(hWinSubClass, GWL_ID, wCtrlID); no, it has ID=1001 already.

// 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.
lPreviousAddress:=SetWindowLong(hWin, GWL_WNDPROC, longint(@MainCtrlWindowProc));

If (lPreviousAddress = 0) Then Begin
   ErrorWrite( ERR_TControl0_CtrlCreate_4, 'in TControl0.CtrlCreate');
   ErrorComment( ERR_TControl0_CtrlCreate_4, 'Handle on control could not be created,');
   ErrorComment( ERR_TControl0_CtrlCreate_4, 'ClassName = ' + strClassName);
   ErrorComment( ERR_TControl0_CtrlCreate_4, 'Label     = ' + strCtrlLabel);
   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(hWin, GWL_USERDATA, longint(@Self));
End;  // TControl0.CtrlCreate

procedure TControl0.GetScreenPosSize(var nXPosV,nYPosV,nWidthV,nHeightV:Int32);
//=============================================================================
// Return the position relative to the screen of the control,
// and its size. All in pixels unit.
var rRec : RECT;
begin
GetWindowRect(hWin, @rRec);
nXPosV   :=rRec.left;
nYPosV   :=rRec.top;
nWidthV  :=rRec.right  - rRec.left;
nHeightV :=rRec.bottom - rRec.top;
end;  // TControl0.GetScreenPosSize

procedure TControl0.RestoreVarLink;
//=================================
// if a variable was linked to this control, then its content was saved.
// Copy back the saved value to the variable
begin
if (pVarLink <> NIL) then begin
   // a variable is linked to this control.
   // Restore the variable's value.

   // Here no type checking is possible, thus crasches are possible
   // if the wrong type is associated with the variable  pVarLink^
   case (rVarLinkInfo.wVarType) of
      vt_Boolean  : boolean(pVarLink^):=rVarLinkInfo.fff;
      vt_Char     : char(pVarLink^):=rVarLinkInfo.ccc;
      vt_Byte     : byte(pVarLink^):=rVarLinkInfo.bbb;
      vt_Integer  : integer(pVarLink^):=rVarLinkInfo.nnn;
      vt_Int16    : int16(pVarLink^):=rVarLinkInfo.n16;
      vt_Int32    : int32(pVarLink^):=rVarLinkInfo.n32;
      vt_word     : word(pVarLink^):=rVarLinkInfo.www;
      vt_word16   : word16(pVarLink^):=rVarLinkInfo.w16;
      vt_word32   : word32(pVarLink^):=rVarLinkInfo.w32;
      vt_FloatS   : FloatS(pVarLink^):=rVarLinkInfo.vss;
      vt_Float    : Float(pVarLink^):=rVarLinkInfo.vvv;
  //  vt_ComplexS : ComplexS(pVarLink^):=rVarLinkInfo.fff;
      vt_Complex  : Complex(pVarLink^):=rVarLinkInfo.pzz^;
      vt_ShortString : ShortString(pVarLink^):=rVarLinkInfo.pstr^;
          // No length checking is done, but
          // since we restore the original string, no problems should occure.
      end; // case wVarLinkType of
   end; // if (pVarLink <> NIL) then begin
end;  // TControl0.RestoreVarLink

function TControl0.UpdateVarLink:word;
//====================================
// This changes the content of the variable linked with this control
// Returns :
// 0 if ok
// 1 if overflow
// 3 if nothing changed. i.e. the variable has the same value as before.
// 4 if not valide text, for example, not valide number.
var
  nLen        : integer; // length of the text in the edit box
  strS        : ShortString; // content of the edit box.
  wVal,
  wCodeWord,
  wCodeInt,
  wCodeFloat
              : word32;
  nVal        : int32;
  vVal        : fLoat;

begin
UpdateVarLink:=3; // nothing changed
if (pVarLink = NIL) then exit;

if (wWindowType = GGLCTE_CTRL_ButtonCheck) or
   (wWindowType = GGLCTE_CTRL_ButtonRadio) then begin
   nVal:=SendMessage(hWin , BM_GETCHECK, 0, 0);
   strS:=IntToStr(nVal,0);
   end
else begin
{if (wWindowType = GGLCTE_CTRL_RichEdit) or
   (wWindowType = GGLCTE_CTRL_EditBox) or
   (wWindowType = GGLCTE_CTRL_ComboBox) then begin }
   nLen:=GetWindowText(hWin, @strS[1], SizeOf(strS)-2);
   strS[0]:=char(nLen);
   end;

//DBW0(64, 'Update =' + strS);


// Special case of an empty edit box
if (length(strS) = 0) then begin
   // we assume that the value is zero
   wCodeWord:=0;  wVal:=0;
   wCodeInt:=0;   nVal:=0;
   wCodeFloat:=0; vVal:=0;
   end
else begin
   // convert the content of the edit box, to assign its value to the linked variable
   // If characters are following the number, they are ignored
   Val(strS, wVal, wCodeWord);
   if (wCodeWord > 1) then Val(Copy(strS,1, wCodeWord-1), wVal, wCodeWord);

   Val(strS, nVal, wCodeInt);
   if (wCodeInt > 1) then Val(Copy(strS,1, wCodeInt-1), nVal, wCodeInt);

   Val(strS, vVal, wCodeFloat);
   if (wCodeFloat > 1) then Val(Copy(strS,1, wCodeFloat-1), vVal, wCodeFloat);
   end;

// If the value of the variable is the same as the value of the control
// return a 3 without changing anything
UpdateVarLink:=3;
case (rVarLinkInfo.wVarType) of
   vt_Boolean  : if (boolean(pVarLink^) = boolean(wVal)) then exit;
   vt_Char     : if (char(pVarLink^)    = strS[1])       then exit;
   vt_Byte     : if (byte(pVarLink^)    = wVal)          then exit;
   vt_Integer  : if (integer(pVarLink^) = nVal)          then exit;
   vt_Int16    : if (int16(pVarLink^)   = nVal)          then exit;
   vt_Int32    : if (int32(pVarLink^)   = nVal)          then exit;
   vt_word     : if (word(pVarLink^)    = wVal)          then exit;
   vt_word16   : if (word16(pVarLink^)  = wVal)          then exit;
   vt_word32   : if (word32(pVarLink^)  = wVal)          then exit;
   vt_FloatS   : if (FloatS(pVarLink^)  = vVal)          then exit;
   vt_Float    : if (Float(pVarLink^)   = vVal)          then exit;
//  vt_ComplexS : ComplexS(pVarLink^):=rVarLinkInfo.fff;
   vt_Complex  : exit;
   vt_ShortString : if (ShortString(pVarLink^) = strS)     then exit;
   end; // case wVarLinkType of

// Update the content of the associated variable.
UpdateVarLink:=0; // We assume it is a valide text.
case rVarLinkInfo.wVarType of
      vt_Boolean : boolean(pVarLink^):=(strS <> '0');
      vt_Char    : char(pVarLink^):=strS[1];
      vt_Byte    : begin
                   if (wCodeInt <> 0) then begin
                      UpdateVarLink:=4;   exit; // do not change anything
                      end;
                   if (wVal > 255) then begin
                      UpdateVarLink:=1; // overflow
                      byte(pVarLink^):= 255;
                      exit;
                      end;

                   byte(pVarLink^):=byte(wVal);
                   end;
      vt_Int16,
      vt_Integer : begin
                   if (wCodeInt <> 0) then begin
                      UpdateVarLink:=4;  exit; // do not change anything
                      end;
                   if (nVal < -32767) then begin
                      UpdateVarLink:=1; // overflow
                      integer(pVarLink^):=-32767;
                      exit;
                      end;
                   if (nVal > 32767) then begin
                      UpdateVarLink:=1; // overflow
                      integer(pVarLink^):=32767;
                      exit;
                      end;

                   // Normal case, we accept the number.
                   if (rVarLinkInfo.wVarType = vt_Integer) then
                        integer(pVarLink^):=nVal
                   else int16(pVarLink^):=nVal;
                   end;
      vt_Int32   : begin
                   if (wCodeInt <> 0) then begin
                      UpdateVarLink:=4;  exit; // do not change anything
                      end;
                   if (nVal < -2147483647) then begin
                      UpdateVarLink:=1; // overflow
                      int32(pVarLink^):=-2147483647;
                      exit;
                      end;
                   if (nVal > 2147483647) then begin
                      UpdateVarLink:=1; // overflow
                      int32(pVarLink^):=2147483647;
                      exit;
                      end;

                   // Normal case, we accept the number.
                   int32(pVarLink^):=nVal;
                   end;
      vt_word    : begin
                   if (wCodeWord <> 0) then begin
                      UpdateVarLink:=4;  exit; // do not change anything
                      end;
                   if (wVal > 65535) then begin
                      UpdateVarLink:=1; // overflow
                      word(pVarLink^):=65535;
                      exit;
                      end;

                   // Normal case, we accept the number.
                   word(pVarLink^):=wVal;
                   end;
      vt_word16  : begin
                   if (wCodeWord <> 0) then begin
                      UpdateVarLink:=4;  exit; // do not change anything
                      end;
                   if (wVal > 65535) then begin
                      UpdateVarLink:=1; // overflow
                      word16(pVarLink^):=65535;
                      exit;
                      end;

                   // Normal case, we accept the number.
                   word16(pVarLink^):=wVal;
                   end;
      vt_word32  : begin
                   if (wCodeWord <> 0) then begin
                      UpdateVarLink:=4;  exit; // do not change anything
                      end;
                   if (wVal > 4294967295) then begin
                      // Useless test, since a word cannot be bigger than 4294967295
                      UpdateVarLink:=1; // overflow
                      word32(pVarLink^):=4294967295;
                      exit;
                      end;

                   // Normal case, we accept the number.
                   word32(pVarLink^):=wVal;
                   end;
      vt_FloatS  : begin
                   if (wCodeFloat <> 0) then begin
                      UpdateVarLink:=4;  exit; // do not change anything
                      end;

                   // No overflow testing
                   FloatS(pVarLink^):=vVal;
                   end;
      vt_Float   : begin
                   if (wCodeFloat <> 0) then begin
                      UpdateVarLink:=4;  exit; // do not change anything
                      end;

                   // No overflow testing
                   Float(pVarLink^):=vVal;
                   end;
  //  vt_ComplexS
//      vt_Complex : (pzz : ^Complex; wSizeComplex:word);
      // The maximum size of the linked var can be less that 255 bytes.
      // it is in fact exactly = rVarLinkInfo.wStrMaxLen
      vt_ShortString : ShortString(pVarLink^):=
                         Copy(strS, 1, rVarLinkInfo.wStrMaxLen);
      // else do nothing
      end; // case

end;  // TControl0.UpdateVarLink

procedure TControl0.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
// It will be overriden by descendent.
// By default, does nothing.
begin
end;  // TControl0.UpdateFromVar

procedure TControl0.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
  nXPosLeft, nYPosTop,  // position in pixels computed from the position given
  nWidth,               // in the control property.
  nHeight
              : int32;

Begin
if (hWin = 0) then exit;

// Converts to pixels the position and sizes of the control
ComputePixPosSizes(nXPosLeft, nYPosTop, nWidth, nHeight);

{DBW0(1, ITS(nXPosLeft  - nXPosLeftLast) +
        ITS(nYPosTop   - nYPosTopLast) +
        ITS(nWidth     - nWidthLast) +
        ITS(nHeight    - nHeightLast)
          ); }

// Test if the position or sizes really changed.
if (nWidth <> nWidthLast) or(nHeight <> nHeightLast) or
   (nXPosLeft <> nXPosLeftLast) or(nYPosTop <> nYPosTopLast) then begin
   // Moves the control at the right place and redraw it.
   MoveWindow ( hWin, nXPosLeft, nYPosTop, nWidth, nHeight, fRedraw);

   // remember the position and size.
   nXPosLeftLast  :=nXPosLeft;
   nYPosTopLast   :=nYPosTop;
   nWidthLast     :=nWidth;
   nHeightLast    :=nHeight;
   end;
end;  // TControl0.NotifyParentResize

procedure TControl0.NotifyChanges;
//================================
// When the button caption, ID, position or size changes,
// this method must be called for the changes to be effectif.
// It is not necessary for if the Hint changes.
begin
strCtrlLabel[length(strCtrlLabel)+1]:=#0;
SetWindowText(hWin, @strCtrlLabel[1]);
SetWindowLong(hWin, GWL_ID, wCtrlID);

// changes the position and sizes.
NotifyParentResize(TRUE);
end;  //  TControl0.NotifyChanges

procedure TControl0.ShowPopupWindowHelp;
//======================================
// if a popup window containing help information must be shown,
// at current mous position, call this methode.
var
  poPopup : PPopupWindow;
begin
poPopup:=gglpoObjCreate^.CreatePopupWindow(@self);
if (poPopup <> NIL) then begin
   poPopup^.colWinText :=gglpoPrm^.colHintText;
   poPopup^.colWinBack :=gglpoPrm^.colHintBack;
   poPopup^.PopupWindowCreate(msgPopupWindowHelp);
   end;
end;  // TControl0.ShowPopupWindowHelp

procedure TControl0.ShowDialogHelp;
//=================================
// Ff a Dialog (usually containing help information) must be shown,
// call this methode.
var poP : PWindowBase;
begin
if (poParent = NIL) then poP:=@Self // the control itself
else if (poParent^.poParent = NIL) then poP:=poParent  // the dialog
else poP:=poParent^.poParent; // the window containing the dialog which contains the control
                              // will receive the messages from the new dialog

DialogExecMSG(msgDialogHelp, poP);
end;  // TControl0.ShowDialogHelp

function TControl0.CtrlWMCTLCOLOR(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT;
//===========================================================================================
// Special case where controls colors can be defines by their parent.
// The controls can define the colors directly through this call.
// lPar = handle on the control who wants to be redrawn
// wPar = Device context used to draw the control.
begin
hWindow:=hWindow; wMsg:=wMsg; wPar:=wPar; lPar:=lPar; // to remove hints
// default handling.
// This can be redefined in descendent.
CtrlWMCTLCOLOR := 0; // Ask to use default message handler.
end;  // TControl0.CtrlWMCTLCOLOR

procedure TControl0.NotifyEndDialogFromDialog(poParentP:PWindowBase; nReturnValueP:int32);
//======================================================================================
// The dialog is notifying all its children that it is about to end
// with the return value = nReturnValue
// If it is IDCANCEL, the original values must be restored.
begin
poParentP:=poParentP; // to avoid a Hint
// If a dialog ended with a CANCEL, then
// restore the origincal values to their variables.
if (nReturnValueP = IDCANCEL) then RestoreVarLink;
end;  // TControl0.NotifyEndDialogFromDialog

procedure TControl0.WMFromParent(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM);
//=====================================================================================
// Messages sent from a parent to all its children.
begin
hWindow:=hWindow; wPar:=wPar; lPar:=lPar; // to avoid Hints

if (wMsg = WM_SIZE) then NotifyParentResize(TRUE);
end;  // TControl0.WMFromParent

procedure TControl0.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.
begin
// Can be redefined in each descendent. If not, do nothing

// to avoid the note '... not used', It doesn't change the final code.
wNotif:=wNotif;
lPar:=lPar;
end;  // TControl0.CtrlNotifMessageHandle

procedure TControl0.CtrlNotifMessageHandleFirst(wNotif:UINT; lPar:LPARAM);
//========================================================================
// Same as  CtrlNotifMessageHandle  but received before the parent.
begin
if ((wNotif = EN_KILLFOCUS) or (wNotif = CBN_KILLFOCUS)) then begin
   // Notify its grand parent, i.e. the main window, that the control is
   // about to loose its focus.
   // In  wRep  send a pointer on a variable, which can be modified,
   // such that if it takes the value  0  then it is not accepted to
   // loose its focus.
   wAcceptQuit:=1;
   if    (poGrParent <> NIL) then poGrParent^.CtrlLooseFocus(@Self, wAcceptQuit)
   else if (poParent <> NIL) then   poParent^.CtrlLooseFocus(@Self, wAcceptQuit);

   if (wAcceptQuit = 0) then SetFocus(hWin); // refuse to loos the focus
   end;

//DBW0(128, 'Notif=' + DBNotifToStr(wNotif) + ITS(wAcceptQuit));

// to avoid the note '... not used', It doesn't change the final code.
lPar:=lPar;
end;  // TControl0.CtrlNotifMessageHandleFirst

procedure TControl0.DrawHint(hWinHint:HWND);
//==========================================
// Draws the Hint. hWinHint = the handle on the Hint window
var
  hDCPaint    : HDC;
  rPaint      : PAINTSTRUCT;
  rRec        : RECT;
  hBr         : HBRUSH;  // needed to paint
  rLogBr      : LOGBRUSH;

Begin
// Gets the info to paint.
hDCPaint :=BeginPaint(hWinHint, @rPaint);

// Sets the text colors.
SetTextColor(hDCPaint, gglpoPrm^.colHintText);
SetBkColor(hDCPaint,  gglpoPrm^.colHintBack);
SetBkMode(hDCPaint, OPAQUE);

// must fill the complete hint window.
rLogBr.lbStyle :=BS_Solid;
rLogBr.lbColor :=gglpoPrm^.colHintBack;
rLogBr.lbHatch :=HS_VERTICAL; // not important since BS_Solid
hBr:=CreateBrushIndirect(rLogBr);

// get the region to be filled
GetClientRect(hWinHint, @rRec);

FillRect(hDCPaint, rRec, hBr);

// must delete the brush to free Windows resources.
DeleteObject(hBr);

strCtrlHint[length(strCtrlHint)+1]:=#0;
TextOut(hDCPaint, 2, 0, @strCtrlHint[1], length(strCtrlHint));

EndPaint(hDCPaint, @rPaint);
end;  //  TControl0.DrawHint

Function HintWindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; stdcall; export;
//==================================================================================================
// This is the message handle function, which calls the
// Window  'WindowProc' function
var
  poCtrl      : PControl0;   // corresponding object control

Begin
if (wMsg = WM_Paint) then begin
   // Gets the pointer on the control owning this Hint.
   poCtrl:=Pointer(GetWindowLong(hWindow, GWL_USERDATA));

   // Call the method which is responsible for painting the hint.
   poCtrl^.DrawHint(hWindow);
   end; // if (wMsg = WM_Paint) then begin

if (wMsg = WM_Destroy) then glhWinHint:=0;

// Call the default event handler
HintWindowProc:=CallWindowProc( WNDPROC(glnLastAdr), hWindow,
                                wMsg, wPar, lPar);
End;  // HintWindowProc

procedure TControl0.WMTimer(wTimerID:WParam);
//===========================================
// To handle timer events.
// used to show hints.
// the way the hint is shown is quite complicate. It could be easier if
// the background of the Hint window could remain grey.
// but since I want to have control over it, I had to take the complicate way.
// Another easier way would have been to use the TStatic object, but
// since it is a descendent of TControl, I disliked to use it here.
// But I tested it, it works well and its a lot simpler.

// Since the global variables glnCpt, glwTimer and glhWinHint are used,
// and local to this procedure, this method cannot be
// redefined in a final application.
// But I Think there is no need for it.
var
  rRecCtrl    : RECT;
  nXMousePos,nYMousePos : int32;
  rPoint      : POINT;
  rSize       : SIZE;
  hDCWin      : HDC;

begin
if (wTimerID <> glwTimer) then exit;

// where is the control in the screen ?
getwindowRect(hWin, @rRecCtrl);

// where is the mouse cursor
GetCursorPos(@rPoint);
nXMousePos:=rPoint.x;
nYMousePos:=rPoint.y;;

if (glnCpt < -gglpoPrm^.nHintStop) and (glhWinHint <> 0) then  begin
   // The hint has been displayed enough time.
   DestroyWindow(glhWinHint);
//   glhWinHint:=0;  done in WM_Destroy

   // But the timer continues, until the mouse cursor gets out of the control
   end;

// is the mouse cursor over the control ?
if ((nXMousePos < rRecCtrl.Left) or (nXMousePos > rRecCtrl.Right)) or
   ((nYMousePos < rRecCtrl.Top ) or (nYMousePos > rRecCtrl.Bottom)) then  begin
   // no, close hint window and kill the timer

   // if hint window open, close it.
   if (glhWinHint <> 0) then begin
      DestroyWindow(glhWinHint);
//      glhWinHint:=0;  done in WM_Destroy
      end;

   KillTimer(hWin, TIMER_HINT_ID);
   glwTimer := 0; // the timer can be used again
   end
else begin
   // yes, the mouse cursor is over the control
   dec(glnCpt); // wait before showing the hint
   if (glnCpt = 0) then begin
      if (strCtrlHint = '') then exit;  // no Hints

      // need to know the size of the text in the hint
      strCtrlHint[length(strCtrlHint)+1]:=#0;
      hDCWin:=GetWindowDC(hWin);
      GetTextExtentPoint32( hDCWin, @strCtrlHint[1], length(strCtrlHint),
                            @rSize);
      ReleaseDC(hWin, hDCWin);

      // show a popup hint window.
      // ! Popup windows are not destroyed automatically. They must be destroyed
      glhWinHint:=CreateWindow('STATIC', @strCtrlHint[1],
                                WS_POPUP or WS_BORDER or SS_CENTER,
                                nXMousePos+gglpoPrm^.nHintDXPos,
                                nYMousePos+gglpoPrm^.nHintDYPos,
                                rSize.cx+gglpoPrm^.nHintDWidth,
                                rSize.cy+gglpoPrm^.nHintDHeight,
                                hWin, 0, System.MainInstance, NIL);

      // redefine a new function to treat the messages of the hint
      glnLastAdr:=SetWindowLong(glhWinHint, GWL_WNDPROC, LPARAM(@HintWindowProc));

      // Indicated which control owns this Hint window.
      SetWindowLong(glhWinHint, GWL_USERDATA, LPARAM(@Self));

      // Show the Hint window, but don't activate it.
      ShowWindow(glhWinHint, SW_SHOWNOACTIVATE);
      end;

   // just to avoid overflow
   if (glnCpt < -20000) then glnCpt:=-10000;
   end;
end;  // TControl0.WMTimer

function TControl0.CtrlWindowProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT;
//===========================================================================================
// Handles the window messages
// A SendMessage(hWin, ...) must not be called from here,
// to avoid calling loops. (SendMessage(hWin...) calls this function
var
  poMenuL     : PMENU;
begin
// Call the previous window proc of a control
if (lPreviousAddress = 0) then begin
   ErrorWrite( ERR_TControl0_CtrlWindowProc_1, 'in TControl0.CtrlWindowProc');
   ErrorComment( ERR_TControl0_CtrlWindowProc_1,
                 'IMPOSSIBLE, Cannot call the original message handler of the control');
   ErrorComment( ERR_TControl0_CtrlWindowProc_1,
                 'Control window name = ' + strWindowName);
   ErrorComment( ERR_TControl0_CtrlWindowProc_1,
                 'Control class = ' + strClassName);
   ErrorComment( ERR_TControl0_CtrlWindowProc_1,
                 'Control label = ' + strCtrlLabel);
   exit;
   end;

{if (wMsg <> WM_MouseMove)   and (wMsg <> WM_NCMouseMove) and
   (wMsg <> WM_MENUSELECT )   and (wMsg <> WM_ENTERIDLE ) and
   (wMsg <> WM_ERASEBKGND )   and (wMsg <> WM_CTLCOLOREDIT) and
   (wMsg <> WM_GETDLGCODE )   and (wMsg <> WM_NCPAINT ) 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(LoWord(wPar))
                             + ITS(HiWord(wPar)) + ITS(lPar));  }
{if (wMsg = WM_SetFocus) or (wMsg = WM_KillFocus) or
   (wMsg = WM_ACTIVATE) or (wMsg = WM_NCACTIVATE) then
   DBW0(16, DBMsgToStr(wMsg) + ITS(LoWord(wPar))
                             + ITS(HiWord(wPar)) + ITS(lPar));}

// If a contextual menu is wanted.
if (wMsg = WM_ContextMenu) and (msgMenuPopup <> 0) and
   (poParent <> NIL) and
   (poParent^.poParent <> NIL) then begin
   poMenuL:=poParent^.poParent^.GetObjectMenu;

   if (poMenuL <> NIL) then begin
      gglpoControlOwnerMenu:=@Self;
      poMenuL^.MenuPopupTrack(
             poParent^.poParent^.hWin, msgMenuPopup, lPar, TPM_RIGHTBUTTON);
      // destroyed automatically the next time you create the popup menu.
      poMenuL^.MenuPopupDestroy;
      end;
   end;

// if the mouse cursor is over a text, show the associated Hint.
if ((wMsg = WM_SetCursor) or (wMsg = WM_MouseMove)) and
   (glwTimer = 0) and (strCtrlHint <> '') then begin
   // a WM_TIMER will be send to  CtrlWindowProc ater two seconds
   glwTimer:=SetTimer( hWin, TIMER_HINT_ID,
                       100,  // timeout in mili-seconds
                       NIL); // a WM_TIMER will be send to  CtrlWindowProc

   // how long do we have to wait before the hint is shown
   glnCpt:=gglpoPrm^.nHintStart;
   end;

if (wMsg = WM_Timer) then WMTimer(wPar); // to handle the Hints.

if (wMsg = WM_Destroy) and (glwTimer <> 0) then begin
   // destroy the popup Hint window
   // ! Popup windows are not destroyed automatically. They must be destroyed.
   DestroyWindow(glhWinHint);

   // if the timer is still active, kill it.
   KillTimer(hWindow, TIMER_HINT_ID);
   glwTimer := 0; // the timer can be used again
   end;

// Default handling of the control
CtrlWindowProc:=CallWindowProc( WNDPROC(lPreviousAddress), hWindow,
                                wMsg, wPar, lPar);

if (wMsg = WM_NCDestroy) then begin
   // The control window has been destroyed, do not destroy it again
   // in the parent TWindowBase0.Dones
   hWin:=0;

   // if the control is destroyed, it cannot be active anymore.
   if (gglpoControlOwnerMenu = @Self) then gglpoControlOwnerMenu:=NIL;
   if (gglpoActiveControl = @Self) then gglpoActiveControl:=NIL;
   end;

// Remark :
// Sometimes it might be easier to treat the notification message send
// to the parent of the control. But we will se later if we must
// take this into account.
end; // TControl0.CtrlWindowProc

end.  // unit wControl0;

