(*************************************************)
(*  Tools.pas                                    *)
(*                                               *)
(*  OWL object wrapper around Microsoft's        *)
(*  common controls.                             *)
(*                                               *)
(*  (c) Copyright 1993. Castle Computer Services *)
(*  All rights reserved.                         *)
(*                                               *)
(*  Author : G.T. Swindell                       *)
(*************************************************)
Unit Tools;
{$F+}
Interface
Uses
  Strings, WinTypes, WinProcs,
  {$IFDEF VER15}
  WObjects;
  {$ELSE}
  OWindows;
  {$ENDIF}

(*******************)
(*  Toolbar Object *)
(*******************)

Type

  { Each button is represented in a single bitmap, divided into sections 16 x 15 pixcels }
  { The bitmap sections are the identified by their postion within that bitmap, staring at 0}

  PBButton = ^TBButton;
  TBButton = Record
    iBitMap : Integer;      { Bitmap offset, Starts at zero }
    idCommand : Integer;    { Command associated with button press }
    fsState : Byte;         { Initial button state }
    fsStyle : Byte;         { Is it a button or space }
    idsHelp : Integer;      { Help identifier associated with the button }
                            { Used to send messages to associated statusbar (if present) }
  end;

Const
  TBSTATE_CHECKED  =      $01;
  TBSTATE_PRESSED  =      $02;
  TBSTATE_ENABLED  =      $04;
  TBSTATE_HIDDEN   =      $08;

  TBSTYLE_BUTTON   =      $00;
  TBSTYLE_SEP      =      $01;
  TBSTYLE_CHECK    =      $02;
  TBSTYLE_GROUP    =      $04;
  TBSTYLE_CHECKGROUP =   (TBSTYLE_GROUP or TBSTYLE_CHECK);

Type
  PAdjustInfo = ^TAdjustInfo;
  TAdjustInfo = Record
    Button : TBButton;
    szDescription : Array[0..1] of Char;
  end;

  PToolBarInfo = ^TToolBarInfo;
  TToolBarInfo = record
    Style : LongInt;           { Toolbar Style }
    ToolbarID : Word;          { Toolbar Control ID }
    NoBitmaps : Integer;       { Number of buttons represented in the bitmap }
    BMInst : tHandle;          { Instance of the Module containing the bitmap }
    BMID : Word;               { Resource ID of the bitmap }
    Buttons : PBButton;        { Buffer containing the TBButton array }
    NoButtons : Integer;       { Number of buttons to add to Toolbar, including spaces }
  end;

Const
  { ToolBar Messages }

  TB_ENABLEBUTTON  =     (WM_USER+1);
  TB_CHECKBUTTON   =     (WM_USER+2);
  TB_PRESSBUTTON   =     (WM_USER+3);
  TB_HIDEBUTTON    =     (WM_USER+4);

(* Messages up to WM_USER+8 are reserved  *)

  TB_ISBUTTONENABLED =   (WM_USER+9);
  TB_ISBUTTONCHECKED =   (WM_USER+10);
  TB_ISBUTTONPRESSED =   (WM_USER+11);
  TB_ISBUTTONHIDDEN  =   (WM_USER+12);

(* Messages up to WM_USER+16 are reserved *)

  TB_SETSTATE       =    (WM_USER+17);
  TB_GETSTATE       =    (WM_USER+18);
  TB_ADDBITMAP      =    (WM_USER+19);
  TB_ADDBUTTONS     =    (WM_USER+20);
  TB_INSERTBUTTON   =    (WM_USER+21);
  TB_DELETEBUTTON   =    (WM_USER+22);
  TB_GETBUTTON      =    (WM_USER+23);
  TB_BUTTONCOUNT    =    (WM_USER+24);
  TB_COMMANDTOINDEX =    (WM_USER+25);
  TB_SAVERESTORE    =    (WM_USER+26);
  TB_CUSTOMIZE      =    (WM_USER+27);

(**********************)
(*  StatusLine Object *)
(**********************)

Const
  STATUSCLASSNAME : PChar = 'msctls_statusbar';
  HEADERCLASSNAME : PChar = 'msctls_headerbar';

  SB_SETTEXT    =        (WM_USER+1);
  SB_GETTEXT    =        (WM_USER+2);
  SB_GETTEXTLENGTH =     (WM_USER+3);
  SB_SETPARTS      =     (WM_USER+4);
  SB_SETBORDERS    =     (WM_USER+5);
  SB_GETPARTS      =     (WM_USER+6);
  SB_GETBORDERS    =     (WM_USER+7);
  SB_SETMINHEIGHT  =     (WM_USER+8);
  SB_SIMPLE        =     (WM_USER+9);

Type
  PStatusInfo = ^TStatusInfo;
  TStatusInfo = record
    Style : LongInt;                    { Initial window style }
    OrigText : PChar;                   { Initial text }
    StatusID : Word;                    { Id. for the statusbar }
    NoOfParts : Byte;                   { Number of sections to the bar }
    Parts : Array[0..255] of Integer;   { Pixel offset with bar for section separators }
    HelpStatusPart : Byte;              { Bar section number to send help strings to }
  end;

const
  { Statusbar Messages }
  HB_SAVERESTORE      =  (WM_USER+$100);
  HB_ADJUST           =  (WM_USER+$101);
  HB_SETWIDTHS        =  SB_SETPARTS;
  HB_GETWIDTHS        =  SB_GETPARTS;
  HB_GETPARTS         =  (WM_USER+$102);
  HB_SHOWTOGGLE       =  (WM_USER+$103);

  SBT_OWNERDRAW       =  $1000;
  SBT_NOBORDERS       =  $0100;
  SBT_POPOUT          =  $0200;
  HBT_SPRING          =  $0400;

{ MENU HELP }

Const
  MINSYSCOMMAND = SC_SIZE;

{ BUTTON LISTBOX }

(* Class name *)
  BUTTONLISTBOX  : PChar =  'ButtonListBox';

(* Button List Box Styles *)
  BLS_NUMBUTTONS : LongInt  =   $00FF;
  BLS_VERTICAL   : LongInt  =   $0100;
  BLS_NOSCROLL   : LongInt  =   $0200;

(* Button List Box Messages *)
  BL_ADDBUTTON      =  (WM_USER+1);
  BL_DELETEBUTTON   =  (WM_USER+2);
  BL_GETCARETINDEX  =  (WM_USER+3);
  BL_GETCOUNT       =  (WM_USER+4);
  BL_GETCURSEL      =  (WM_USER+5);
  BL_GETITEMDATA    =  (WM_USER+6);
  BL_GETITEMRECT    =  (WM_USER+7);
  BL_GETTEXT        =  (WM_USER+8);
  BL_GETTEXTLEN     =  (WM_USER+9);
  BL_GETTOPINDEX    =  (WM_USER+10);
  BL_INSERTBUTTON   =  (WM_USER+11);
  BL_RESETCONTENT   =  (WM_USER+12);
  BL_SETCARETINDEX  =  (WM_USER+13);
  BL_SETCURSEL      =  (WM_USER+14);
  BL_SETITEMDATA    =  (WM_USER+15);
  BL_SETTOPINDEX    =  (WM_USER+16);

(* Button listbox notification codes send in WM_COMMAND *)
  BLN_ERRSPACE      =  (-2);
  BLN_SELCHANGE     =  1;
  BLN_CLICKED       =  2;
  BLN_SELCANCEL     =  3;
  BLN_SETFOCUS      =  4;
  BLN_KILLFOCUS     =  5;

(* Message return values *)
  BL_OKAY           =  0;
  BL_ERR            =  (-1);
  BL_ERRSPACE       =  (-2);

Type
  PCreateListButton = ^TCreateListButton;
  TCreateListButton = Record
    cbSize : Word;           { size of structure }
    dwItemData : LongInt;    { user defined item data }
                             { for LB_GETITEMDATA and LB_SETITEMDATA }
    BitMap : hBitMap;        { button bitmap }
    lpszText : PChar;        { button Text }
  end;

{ TRACK BAR }

Const
  TRACKBAR_CLASS  : PChar = 'msctls_trackbar';

{ Trackbar styles }
  TBS_AUTOTICKS   : LongInt =  $0001;

  TBM_GETPOS           =   (WM_USER);
  TBM_GETRANGEMIN      =   (WM_USER+1);
  TBM_GETRANGEMAX      =   (WM_USER+2);
  TBM_GETTIC           =   (WM_USER+3);
  TBM_SETTIC           =   (WM_USER+4);
  TBM_SETPOS           =   (WM_USER+5);
  TBM_SETRANGE         =   (WM_USER+6);
  TBM_SETRANGEMIN      =   (WM_USER+7);
  TBM_SETRANGEMAX      =   (WM_USER+8);
  TBM_CLEARTICS        =   (WM_USER+9);
  TBM_SETSEL           =   (WM_USER+10);
  TBM_SETSELSTART      =   (WM_USER+11);
  TBM_SETSELEND        =   (WM_USER+12);
  TBM_GETPTICS         =   (WM_USER+14);
  TBM_GETTICPOS        =   (WM_USER+15);
  TBM_GETNUMTICS       =   (WM_USER+16);
  TBM_GETSELSTART      =   (WM_USER+17);
  TBM_GETSELEND        =   (WM_USER+18);
  TBM_CLEARSEL         =   (WM_USER+19);

{ these match the SB_ (scroll bar messages) }

  TB_LINEUP            =   0;
  TB_LINEDOWN          =   1;
  TB_PAGEUP            =   2;
  TB_PAGEDOWN          =   3;
  TB_THUMBPOSITION     =   4;
  TB_THUMBTRACK        =   5;
  TB_TOP               =   6;
  TB_BOTTOM            =   7;
  TB_ENDTRACK          =   8;

{ DRAG LIST }

Type
  PDragListInfo = ^TDragListInfo;
  TDragListInfo = Record
    uNotification : Word;
    Wnd : hWnd;
    ptCursor : tPoint;
  end;

Const
  DL_BEGINDRAG      =      (LB_MSGMAX+100);
  DL_DRAGGING       =      (LB_MSGMAX+101);
  DL_DROPPED        =      (LB_MSGMAX+102);
  DL_CANCELDRAG     =      (LB_MSGMAX+103);

  DL_CURSORSET      =      0;
  DL_STOPCURSOR     =      1;
  DL_COPYCURSOR     =      2;
  DL_MOVECURSOR     =      3;

  DRAGLISTMSGSTRING :PChar = 'commctrl_DragListMsg';

{ UP DOWN }

Type
  PUDAccel = ^TUPAccel;
  TUPAccel = Record
    nSec : Word;
    nInc : Word;
  end;

Const
  UD_MAXVAL         =  $7FFF;
  UD_MINVAL         =  (-UD_MAXVAL);
  UD_UNSIGNED_MAXVAL=  $FFFF;
  UD_UNSIGNED_MINVAL=  0;

  UDS_WRAP           = $0001;
  UDS_SETBUDDYINT    = $0002;
  UDS_ALIGNRIGHT     = $0004;
  UDS_ALIGNLEFT      = $0008;
  UDS_AUTOBUDDY      = $0010;
  UDS_ARROWKEYS      = $0020;

  UDM_SETRANGE       = (WM_USER+101);
  UDM_GETRANGE       = (WM_USER+102);
  UDM_SETPOS         = (WM_USER+103);
  UDM_GETPOS         = (WM_USER+104);
  UDM_SETBUDDY       = (WM_USER+105);
  UDM_GETBUDDY       = (WM_USER+106);
  UDM_SETACCEL       = (WM_USER+107);
  UDM_GETACCEL       = (WM_USER+108);
  UDM_SETBASE        = (WM_USER+109);
  UDM_GETBASE        = (WM_USER+110);

  UPDOWN_CLASS : PChar = 'msctls_updown';

Const
  HBN_BEGINDRAG     =  $0101;
  HBN_DRAGGING      =  $0102;
  HBN_ENDDRAG       =  $0103;
  HBN_BEGINADJUST   =  $0111;
  HBN_ENDADJUST     =  $0112;
  TBN_BEGINDRAG     =  $0201;
  TBN_ENDDRAG       =  $0203;
  TBN_BEGINADJUST   =  $0204;
  TBN_ADJUSTINFO    =  $0205;
  TBN_ENDADJUST     =  $0206;
  TBN_RESET         =  $0207;
  TBN_QUERYINSERT   =  $0208;
  TBN_QUERYDELETE   =  $0209;
  TBN_TOOLBARCHANGE =  $020A;
  TBN_CUSTHELP      =  $020B;

  CCS_TOP        : Longint =     $00000001;
  CCS_NOMOVEY    : Longint =     $00000002;
  CCS_BOTTOM     : Longint =     $00000003;
  CCS_NORESIZE   : Longint =     $00000004;
  CCS_NOPARENTALIGN  : Longint = $00000008;
  CCS_NOHILITE   : Longint =     $00000010;
  CCS_ADJUSTABLE : Longint =     $00000020;

(**********************************************************)
(*  MAIN OBJECT FOR TOOLBAR/MENU/STATUSLINE COMMUNICATION *)
(**********************************************************)

Type
  PToolWindow = ^TToolWindow;
  TToolWindow = object(TWindow)
    Constructor Init(AParent : PWindowsObject; AName : PChar; ToolInfo : TToolBarInfo; StatusLineInfo : TStatusInfo);
    Procedure SetupWindow; virtual;
    Procedure DefChildProc(var msg : TMessage); virtual;
    Procedure WM_MenuSelected(var Msg : TMessage); virtual wm_First + wm_MenuSelect;
    Procedure SetStatusText(Part, DrawType : Byte; Str : PChar); virtual;
    Procedure HideToolBar;
    Procedure ShowToolBar;
  private
    hToolBar : tHandle;
    hStatusBar : tHandle;
    ToolBarInfo : PToolBarInfo;
    StatusBarInfo : PStatusInfo;
    ButtonInfo : PBButton;
  end;

Implementation
{$IFNDEF VER15}
Uses
  Objects;
{$ENDIF}

(******************)
(*  GENERAL STUFF *)
(******************)

Function CreateToolBar(Wnd : hWnd; ws : LongInt; wID : Word; nBitmaps : Integer;
                       hBMisnt : tHandle; wBMID : Word; lpButtons : pBButton;
                       iNumButtons : Integer) : HWnd; external 'COMMCTRL' index 7;

Procedure DrawStatusText(dc : hDC; lprc : PRect; szText : PChar; uFlags : Word);  external 'COMMCTRL' index 5;
Function CreateStatusWindow(Style : LongInt; lpszText : PChar; hwndParent : hWnd; wID : Word) : hWnd;
                                               external 'COMMCTRL' index 6;

Function WritePrivateProfileStruct(szSection : PChar; szKey : PChar; lpStruct : PByte;
                                   uSizeStruct : Word; szFile : PChar) : BOOL; external 'COMMCTRL' index 10;
Function GetPrivateProfileStruct(szSection : PChar; szKey : PChar; lpStruct : PByte; uSizeStruct : Word;
                                 szFile : PChar) : BOOL; external 'COMMCTRL' index 11;
Procedure MenuHelp(iMessage : Word; wParam : Word; lParam : LongInt; hMainMenu : hMenu; hInst : tHandle; hwndStatus : hWnd;
                   lpwIDs :pWord); external 'COMMCTRL' index 2;
Function ShowHideMenuCtl(Wnd : hWnd; uFlags : Word; lpInfo : PInteger) : BOOL; external 'COMMCTRL' index 3;
Procedure GetEffectiveClientRect(Wnd : hWnd; lprc : PRect; lpInfo : PInteger); external 'COMMCTRL' index 4;
Function CreateUpDownControl(dwStyle : LongInt; x, y, cx, cy : Integer;
                             hParent : hWnd; nID : Integer; Inst : tHandle;
                             hBuddy : hWnd; nUpper, nLower, nPos : Integer) : hWnd; external 'COMMCTRL' index 16;
Procedure InitCommonControls; external 'COMMCTRL' index 17;

(**********************************************************)
(*  MAIN OBJECT FOR TOOLBAR/MENU/STATUSLINE COMMUNICATION *)
(**********************************************************)

Constructor TToolWindow.Init(AParent : PWindowsObject; ANAme : PChar; ToolInfo : TToolBarInfo; StatusLineInfo : TStatusInfo);
begin
  TWindow.Init(AParent, AName);
  GetMem(ToolBarInfo, Sizeof(ToolInfo));
  Move(ToolInfo, ToolBarInfo^, Sizeof(ToolInfo));

  GetMem(ButtonInfo, Sizeof(TBButton) * ToolInfo.NoButtons);
  Move(ToolInfo.Buttons^, ButtonInfo^, Sizeof(TBButton) * ToolInfo.NoButtons);

  GetMem(StatusBarInfo, Sizeof(StatusLineInfo));
  Move(StatusLineInfo, StatusBarInfo^, Sizeof(StatusLineInfo));
end;

Procedure TToolWindow.SetupWindow;
begin
  TWindow.SetupWindow;
  { Set up the Toolbar Information }
  With ToolBarInfo^ do
  begin
    Style := Style or WS_CHILD;
    hToolBar := CreateToolBar(hWindow, Style, ToolBarID, NoBitmaps, BMInst,
                                BMID, ButtonInfo, NoButtons);
  end;
  SendMessage(hToolBar, WM_Size, 0, 0); { Null WM_Size message - Sets default size & position }

  With StatusBarInfo^ do
  begin
    Style := Style OR WS_Child;
    hStatusBar := CreateStatusWindow(Style, OrigText, hWindow, StatusID);
    SendMessage(hStatusBar, WM_Size, 0, 0); {Null WM_Size message - Sets default size & position }
    If NoOfParts > 1 then { Set the number of parts to the Statusbar }
      SendMessage(hStatusBar, SB_SetParts, NoOfParts, LongInt(@Parts));
  end;
end;

(**************************************)
(* DefChildProc                       *)
(*                                    *)
(*  Traps Mouse movements into the    *)
(*  toolbar and translates them into  *)
(*  messages on the statusbar.        *)
(*                                    *)
(**************************************)

Procedure TToolWindow.DefChildProc(var msg : TMessage);
Var
  Button : TBButton;
  P : Array[0..100] of Char;
  Result : LongInt;

begin
  TWindow.DefChildProc(Msg);
  If Msg.wParam = ToolBarInfo^.ToolBarID then { Send Help String to the Status Bar }
  begin
    If (Msg.LParamHi = TBN_BEGINDRAG) then
    begin
      Result := SendMessage(hToolBar, TB_CommandToIndex, msg.lParamLo, 0);
      SendMessage(hToolBar, TB_GetButton, Result, LONGINT(@Button));
      LoadString(hInstance, Button.idsHelp, @p, 100);
      SendMessage(hStatusBar, sb_SetText, StatusBarInfo^.HelpStatusPart, LongInt(@p));
    end
    else
    begin { otherwise write a blank to the Statusline }
      SendMessage(hStatusBar, sb_SetText, StatusBarInfo^.HelpStatusPart, 0);
    end;
  end;
end;

(**************************************)
(* WM_MenuSelected                    *)
(*                                    *)
(*  Traps menu events and translates  *)
(*  them into messages on the         *)
(*  statusbar.                        *)
(*                                    *)
(**************************************)

Procedure TToolWindow.WM_MenuSelected(var MSg : TMessage);
Var
  Button : TBButton;
  P : Array[0..100] of Char;
  Result : LongInt;
begin
  DefWndProc(Msg);
  If Msg.wParam <> 0 then
  begin
    { Get the string corresponding to the Menu ID }
    LoadString(hInstance, msg.wParam, @p, 100);
    { Send it to the status bar }
    SendMessage(hStatusBar, sb_SetText, StatusBarInfo^.HelpStatusPart, LongInt(@p));
  end
  else
    SendMessage(hStatusBar, sb_SetText, StatusBarInfo^.HelpStatusPart, 0);
end;

(**************************************)
(* SetStatusText                      *)
(*                                    *)
(*  Sets the text on the statusbar.   *)
(*  according to the part and style   *)
(*  passed to the function.           *)
(*                                    *)
(**************************************)

Procedure TToolWindow.SetStatusText(Part, DrawType : Byte; Str : PChar);
Var
  wParam : WordRec;

begin
  wParam.lo := Part;
  wParam.hi := DrawType;
  SendMessage(hStatusBar, SB_SETTEXT, WORD(wParam), LONGINT(Str));
end;

(**************************************)
(* HideToolBar                        *)
(*                                    *)
(*  Removes the toolbar from the      *)
(*  window.                           *)
(*                                    *)
(**************************************)

Procedure TToolWindow.HideToolBar;
begin
  SendMessage(hToolBar, wm_Close, 0, 0); { Close the toolbar }
  hToolBar := 0;
end;

(**************************************)
(* ShowToolBar                        *)
(*                                    *)
(*  Re-creates the toolbar after it   *)
(*  has been hidden.                  *)
(*                                    *)
(**************************************)

Procedure TToolWindow.ShowToolBar;
begin
  If hToolBar = 0 then
  begin
    With ToolBarInfo^ do
    begin
      Style := Style or WS_CHILD;
      { Re-create the toolbar }
      hToolBar := CreateToolBar(hWindow, Style, ToolBarID, NoBitmaps, BMInst,
                                BMID, ButtonInfo, NoButtons);
    end;
    SendMessage(hToolBar, WM_Size, 0, 0);
  end;
end;

end.