unit wToolBar0;

{ 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.

  To create a toolBar, without using resources.
  It will simplify creating a toolBar, with a simple description
  in a text file.

  Is based on the creation of a dialog Box
-----------------------------------------------------}

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

type
  PToolBar0 = ^TToolBar0;
  TToolBar0 = object(TDialog)
  //"""""""""""""""""""""""""
//  hWin    : HWND;  // Handle on the ToolBar, got from TWindowBase
//  hParent : HWND;  // Handle on the parent, got from TWindowBase
//  poParent: PWindowBase0;  // Pointer on the parent, got from TWindowBase

// The height of the horizontal tool bar is defined in : nYSizePix
// The width of the vertical tool bar is defined in : nXSizePix

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

  wTBPosition : word32;
  // 1 => top & horizontal
  // 3 => bottom & horizontal
  // 16 => left & vertical
  // 48 => right & vertical

// fLButtonDown : boolean;
// rPTOrg : POINT;

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

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

  procedure ToolBarFillWithChild; virtual;
  // Fill the ToolBar with its child control window

  procedure ToolBarCreate; virtual;
  // Creates a new ToolBar.
  // Returns the handle on the ToolBar in  hWin.

  function WMNotifyTB(wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;
  // Handles the notification messages send from the controls

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

  function ToolBarProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; virtual;
  // Handles the ToolBar messages
  // It is seldom overriden, since most (all) messages are
  // treated in  WMCommand.
  // Should return LRESULT = 1 if the message was processed,
  // LRESULT = 0 otherwise.

  end; // TToolBar0 = object(TDialog)
  TToolBar =  TToolBar0;
  PToolBar = ^TToolBar;

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

uses wControl0, wErrors2 ,wDebug0;

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

Function TheToolBarProc(hToolBar:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT; stdcall; export;
//===================================================================================================
// This is the message handle function, which calls the
// 'ToolBarProc' function
var
  // corresponding object ToolBar to the  hToolBar  handle
  poTBar      : PToolBar0;

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

{if (wMsg <> WM_MOUSEMOVE) and (wMsg <> WM_SetCursor) and
   (wMsg <>  WM_NCHITTEST) then
   DBW0(1024, DBMsgToStr(wMsg) + ITS(wPar) + ITS(lPar) + PTS(poDlg)); }

if (poTBar = NIL) or IsBadWritePtr(poTBar, sizeOf(TToolBar)) then begin
   ErrorWriteMsg(2001015001);
   exit;
   end;

// The object ToolBar method is called.
TheToolBarProc := poTBar^.ToolBarProc(hToolBar, wMsg, wPar, lPar);
End;  // TheToolBarProc

//***************************************************
// TToolBar0 = object(TDialog)
//***************************************************

constructor TToolBar0.Init(poParentW:PWindowBase);
//===============================================
begin
inherited Init(poParentW);

wWindowType :=GGLCTE_ToolBar; // def. in wGlobals2.pp

// This will be set at creation.
lPreviousAddress :=0;
wTBPosition      :=0;

nXPosPix  :=0;
nYPosPix  :=0;
nXSizePix :=200;
nYSizePix :=50;

// Default style of the dialog box
dwStyle   :=WS_CHILD; // or WS_BORDER;
dwExStyle :=0;

// fLButtonDown:=FALSE;

end;  // TToolBar0.Init

destructor TToolBar0.Done;
//=======================
begin
// remove it from the list of child Windows of its parent.
if (poParent <> NIL) then poParent^.RemoveChildObjectWindow(@Self);
poParent:=NIL;

inherited Done;
end;  // TToolBar0.Done

procedure TToolBar0.ToolBarFillWithChild;
//=======================================
// Fill the ToolBar with its child control window
var
  nn          : integer;
begin

// Fills the toolbar with the buttons
for nn:=1 to nNumberOfChild do begin
   if (papoChild^[nn] <> NIL) and
      (papoChild^[nn]^.hWin = 0) and
      (papoChild^[nn]^.wWindowType >= 200) and
      (papoChild^[nn]^.wWindowType <= 500) then begin
      // the child window has still not been created.
      // And it is a control, thus create it
      PControl(papoChild^[nn])^.CtrlCreate;
      end; // if
   end; // for
end;  // TToolBar0.ToolBarFillWithChild

procedure TToolBar0.ToolBarCreate;
//================================
// Creates a new Modeless ToolBar.
// Returns the handle on the ToolBar in  hWin.
Begin
// It is supposed that the poParent is a valid pointer, if non NIL.
if (poParent <> NIL) then
     hParent :=poParent^.hWin // both are always the same
else hParent:=0;              // A ToolBar box without a parent !

{
// For tests
dwStyle   :=WS_POPUPWINDOW or WS_CAPTION;
dwExStyle :=WS_EX_TOOLWINDOW;
nYSizePix:=nYSizePix + 24;
nXSizePix:=400;
}

if (nXSizePix > nYSizePix) then begin
   // horizontal
   wTBPosition:=1;
   if (nYPosPix > nYSizePix) then wTBPosition:=3; // bottom
   end
else begin
   // vertical
   wTBPosition:=16;
   if (nXPosPix > nXSizePix) then wTBPosition:=48; // right
   end;

// Create an empty ToolBar box. It will be filled later.
gglstrClassWinName[length(gglstrClassWinName)+1]:=#0;
hWin:=CreateWindowEx(dwExStyle, @gglstrClassWinName[1],
                        NIL,
                        dwStyle,
                        nXPosPix,nYPosPix, nXSizePix, nYSizePix, // position and size
                        hParent,
                        0, // no menu
                        System.MainInstance,
                        NIL);

// 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(@TheToolBarProc));

If (lPreviousAddress = 0) Then Begin
   ErrorWriteMSG(2001015011);
   exit;  // can't do anything more
   end;

// Memorise in the window's data, that Self is the associated object.
SetWindowLong(hWin, GWL_USERDATA, longint(@Self));

// Fills the toolbar with its child windows
ToolBarFillWithChild;

// Show the window ToolBar box
ShowWindow(hWin, SW_SHOWNORMAL)
End;  // TToolBar0.ToolBarCreate

function TToolBar0.WMNotifyTB(wPar:WPARAM; lPar:LPARAM):LRESULT;
//==============================================================
// Handles the notification messages send from control
// It is usually overriden, if used.
var
  prNH        : ^NMHDR; // info associated with the notification message
  poCtrl      : PControl;

begin
// Notification message information. From whom and what.
prNH:=Pointer(lPar);

// The problem is that the handle doesn't identify always the control.
// only controls that has been defined in the library.
poCtrl:=Pointer(GetWindowLong(prNH^.hwndFrom, GWL_USERDATA));

// If the pointer is valid and represent the same handle, then
// it is a pointer on the object corresponding to the control.
if (not IsBadReadPtr(poCtrl, sizeOf(TControl0))) then begin
//   DBW0(2048, DBNotifToStr(prNH^.Code) + ITS(poCtrl^.hWin) + ' = ' + ITS(prNH^.hwndFrom));
   if (poCtrl^.hWin = prNH^.hwndFrom) then begin
      // the control has been identified to be the one having the right handle
      // Calls the notification message to the control's notification message handler
      // poCtrl^.Code = notification message, as NM_XXX and EN_XXX and ...
      poCtrl^.CtrlNotifMessageHandle(prNH^.Code, lPar);
      end;
   end;

// Default handling of the ToolBarProc
WMNotifyTB :=CallWindowProc( WNDPROC(lPreviousAddress), hWin,
                           WM_Notify, wPar, lPar);
end;  //TToolBar0.WMNotifyTB

function TToolBar0.WMCommandTB(wPar:WPARAM; lPar:LPARAM):LRESULT;
//===============================================================
// Handles the menu messages
var
  poCtrl      : PControl;
  wNoticode   : word;

begin
if (poParent = NIL) or (poParent^.hWin = 0) then begin  // Not normal
   // Default handling of the ToolBarProc
   WMCommandTB :=CallWindowProc( WNDPROC(lPreviousAddress), hWin,
                                 WM_Command, wPar, lPar);
   exit;
   end;

if (lPar <> 0) then begin
   // It is a notification message send from the child control to its parent.
   // send it back to the object control
   wNotiCode := HiWord(wPar);

   // this message is a notification code from the control.
   // lPar = handle of the control, get the pointer on the object.
   poCtrl:=Pointer(GetWindowLong(lPar, GWL_USERDATA));

   // If the pointer is valid and represent the same handle, then
   // it is a pointer on the object corresponding to the control.
   if (not IsBadReadPtr(poCtrl, sizeOf(TControl0))) then begin
//      DBW0(4096, DBNotifToStr(wNotiCode) + ITS(poCtrl^.hWin) + ' = ' + ITS(lPar));
      if (poCtrl^.hWin = lPar) then begin
         // The control has been identified to be the one having the right handle
         // Calls the notification message to the control's notification
         // message handler
         // poCtrl^.Code = notification message, as NM_XXX and EN_XXX and ...
         poCtrl^.CtrlNotifMessageHandle(wNotiCode, lPar);
         end;
      end;

   // Buttons in the tool bar don't keep their focus.
   if (poCtrl^.wWindowType = GGLCTE_CTRL_ButtonPush) or
      (poCtrl^.wWindowType = GGLCTE_CTRL_ButtonBitMap) then SetFocus(hParent);
   end; // if (lPar <> 0) then begin

// send the notification message further to its parent.
SendMessage(poParent^.hWin, WM_Command, wPar, 0);
WMCommandTB :=0;
end;  // TToolBar0.WMCommandTB

function TToolBar0.ToolBarProc(hWindow:HWND; wMsg:UINT; wPar:WPARAM; lPar:LPARAM):LRESULT;
//======================================================================================
var
  hDevC       : HDC;
  rRec        : RECT;
  hBr         : HBrush;
  poTBar      : PToolBar0;
//  rPt         : POINT;

begin
// Default treatment of a message. Does nearly nothing
ToolBarProc:=1; // default return value, if processed

{ 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(LoWord(wPar))
                             + ITS(HiWord(wPar)) + ITS(lPar)); }


Case wMsg Of
   WM_Notify  : ToolBarProc:=WMNotifyTB( wPar, lPar);
   WM_Command : ToolBarProc:=WMCommandTB(wPar, lPar);

   WM_ERASEBKGND : begin
      // change the color of the window background
      // It is quite complicate for a simple task !
      hDevC:=HDC(wPar);  // the handle on the device context is given.
      GetClientRect(hWindow, @rRec);

      // you must get a brush to paint.
      // you could also create a brush with CreateSolidBrush
      hBr:=GetStockObject(LTGRAY_BRUSH);

      FillRect(hDevC, rRec, hBr);

      ToolBarProc:=1; // <> 0 should be returned if backgroud erased.
      end; // WM_ERASEBKGND

{ To be able to move the toolbar.
  The window must be copied into a popupwindow, then destroyed.
  But the object can be kept.
   WM_LBUTTONDOWN : begin
// It does not work
//      SetWindowLong(hWin, GWL_STYLE, WS_POPUP or WS_VISIBLE);

      fLButtonDown:=TRUE;
      SetCapture(hWin);

      // Remember where we clicked, to move the toolBar
      GetCursorPos(rPTOrg);
      GetWindowRect(hWin, rRec);
      rPT.x:=rRec.left;
      rPT.y:=rRec.top;
      ScreenToClient(poParent^.hWin, rPT);
      rPTOrg.x:=rPT.x - rPTOrg.x;
      rPTOrg.y:=rPT.y - rPTOrg.y;
      end;

   WM_LBUTTONUP : begin
      fLButtonDown:=FALSE;
      ReleaseCapture;
      end;

   WM_MOUSEMOVE : if fLButtonDown then begin
      GetCursorPos(rPT);
      MoveWindow(hWin, rPT.x + rPTOrg.x, rPT.Y + rPTOrg.y, nXSizePix, nYSizePix, TRUE);
      end;
}
   else begin // of case
     // Default handling of the ToolBarProc
     ToolBarProc:=CallWindowProc( WNDPROC(lPreviousAddress), hWindow,
                                  wMsg, wPar, lPar);
      end;
   End; // Case wMsg Of

if (wMsg = WM_NCDESTROY) then begin
   hWin:=0;  // do not destroy again.

   if (wIsDone = 1) then begin
      // dispose also the object
      poTBar :=@Self;
      dispose(poTBar, Done);
      end;
   // else it has already been disposed.
   end;

end;  // TToolBar0.ToolBarProc

end.  // unit wToolBar0;

