{
  ------------------------------------------------------------------------------
  Scrollbar unit for Free Pascal by

  Guus Scholten
  E-Mail : jacco@wishmail.net

  Free Pascal version used : 1.0.6 under Windows ME


  ------------------------------------------------------------------------------
  History:
  DD/MM/YYYY
  26/06/2003: by Guus Scholten (jacco@wishmail.net)
              + initial creation
}


{
  Unit ScrollBars

  Purpose : Easy way of creating and handling of scrollbars

  Creating the Scrollbars :

   1. For every window that needs scrollbars declare a
      variable of type "ScrollInfoEx".
   2. Initialise the variable using the InitScrollInfoEx function
      -- This can be done when processing the WM_CREATE message.
   3. Optionaly set the Step size using the SetScrollStep function.
      -- Default step size = 1, negative values are ignored and
         therefore setting iHStep = -1 and iVStep = 2 will only change
         the Vertical step value.
   4. Process the WM_SIZE message using the SizeScrollBars function.
   5. Process the WM_VSCROLL message using the VertScroll function
      & Process the WM_HSCROLL message using the HorzScroll function.
   6. During WM_PAINT message handling use the GetScrollPos function to
      obtain current scroll position.

   note: The SizeScrollBars function is the actual function that turns
         scrollbars on/off and can be used to do so at any time,
         not just during WM_SIZE processing.

}
unit ScrollBars;

interface

uses
  windows;

type
  ScrollInfoEx  = record
                    iHScrollMax  : integer;  { Total size of window }
                    iVscrollMax  : integer;
                    iHscrollPos  : integer;  { Current upper left position of visible window }
                    iVscrollPos  : integer;
                    iVscrollStep : integer;  { Scroll inscrease step size }
                    iHscrollStep : integer;
                  end;
  PScrollInfoEx = ^ScrollInfoEx;

{
  Procedure InitScrollInfoEx

  Purpose : Initialization of a ScrollInfoEx structure

  In      : ScrollInf : ScrollInfoEx Structure to Initialize.

  Out     : ScrollInf : Initialized Structure
}
procedure InitScrollInfoEx (var ScrollInf : ScrollInfoEx);

{
  Procedure SizeScrollBars

  Purpose : Initialization of a ScrollBars of a window
            When the horizontal length or the vertical length is
            greater then the window size a scroll bar will be displayed.
            The window will show a display of the upper left part of
            the total display.

  In      : Window    : Handle to Window.
            cxTotal   : Total horizontal size.
            cyTotal   : Total vertical size.
            ScrollInf : ScrollInfoEx Structure for this window.

  Out     : window with Scrollbars, some information will be kept
            in the ScrollInf variable
}
procedure SizeScrollBars (    Window           : Hwnd;
                              cxTotal, cyTotal : integer;
                          var ScrollInf        : ScrollInfoEx);

{
  Procedure HorzScroll / VertScroll

  Purpose : To process the WM_HSCROLL / WM_VSCROLL messages

  In      : Window    : Handle to Window.
            WParam    : The WPARAM value passed with WM_HSCROLL / WM_VSCROLL.
            ScrollInf : ScrollInfoEx Structure for this window.

  Out     : Window will be scrolled, (display update messages sent).
}
procedure HorzScroll (    window    : Hwnd;
                          WParam    : WParam;
                      var ScrollInf : ScrollInfoEx);
procedure VertScroll (    window    : Hwnd;
                          WParam    : WParam;
                      var ScrollInf : ScrollInfoEx);

{
  Procedure GetScrollPos

  Purpose : To retreive current scroll position
            (Top left corner of display).

  In      : ScrollInf : ScrollInfoEx Structure for this window.

  Out     : iHScroll  : Horizontal scroll position
            iVscroll  : Vertical scroll position
}
procedure GetScrollPos (var   iHScroll, iVScroll : integer;
                        const ScrollInf          : ScrollInfoEx);

{
  Procedure GetScrollPos

  Purpose : To set the Scroll step values.

  In      : iHStep    : new horizontal step value, a negative value is ignored.
            iVStep    : new vertical step value, a negative value is ignored.
            ScrollInf : ScrollInfoEx Structure for this window.

  Out     : ScrollInf : ScrollInfoEx Structure for this window (values updated).
}
procedure SetScrollStep (iHStep, iVStep : integer; var ScrollInf : ScrollInfoEx);

implementation

procedure InitScrollInfoEx (var ScrollInf : ScrollInfoEx);
  begin
    with ScrollInf do
    begin
      iHScrollMax  := 0;
      iVscrollMax  := 0;
      iHscrollPos  := 0;
      iVscrollPos  := 0;
      iHscrollStep := 1;
      iVscrollStep := 1;
    end;
  end;

procedure SizeScrollBars (Window                : Hwnd;
                          cxTotal, cyTotal      : integer; { Size of Virtual window }
                          var ScrollInf         : ScrollInfoEx);
  var
    rc : RECT;
  begin
    with ScrollInf do
    begin
      GetClientRect(Window, @rc);

      iHscrollMax := max (0, cxTotal - rc.right);
      iHscrollPos := min (iHscrollPos, iHscrollMax);

      SetScrollRange(Window, sb_horz, 0, iHscrollMax, false);
      SetScrollPos  (Window, sb_horz, iHscrollPos, true);

      GetClientRect(Window, @rc);

      iVscrollMax := max ( 0, cyTotal - rc.bottom);
      iVscrollPos := min (iVscrollPos, iVscrollMax);

      SetScrollRange(Window, sb_vert, 0, iVscrollMax, false);
      SetScrollPos  (Window, sb_vert, iVscrollPos, true);
    end;
  end;

procedure VertScroll (window : Hwnd; WParam : WParam; var ScrollInf : ScrollinfoEx);
  var
    iVscrollInc : integer;
    rc          : RECT;
    prc         : PRECT;
  begin
    prc := nil;
    GetClientRect(Window, @rc);
    with ScrollInf do
    begin
      case Lo (WParam) of
        sb_top        : iVscrollInc := -iVscrollPos;
        sb_bottom     : iVscrollInc := iVscrollMax - iVscrollPos;
        sb_lineup     : iVscrollInc := - iVscrollStep;
        sb_linedown   : iVscrollInc := + iVscrollStep;
        sb_pageup     : iVscrollInc := - max (1, rc.bottom);
        sb_pagedown   : iVscrollInc :=   max (1, rc.bottom);
        sb_thumbtrack : iVscrollInc := Hi(WParam) - iVscrollPos;
        else iVscrollInc := 0;
      end;
      iVscrollInc := max (-iVscrollPos,  min(iVscrollInc, iVscrollMax - iVscrollPos));
      if iVscrollInc <> 0
      then begin
             iVscrollPos := iVscrollPos + iVscrollInc;
             ScrollWindow  (window, 0, -iVscrollInc, prc^, prc^);
             SetScrollPos  (Window, sb_vert, iVscrollPos, true);
             UpdateWindow(window);
           end;
    end;
  end;

procedure HorzScroll (window : Hwnd; WParam : WParam; var ScrollInf : ScrollInfoEx);
  var
    iHscrollInc : integer;
    rc          : RECT;
    prc         : PRECT;
  begin
    prc := nil;
    GetClientRect(Window, @rc);
    with ScrollInf do
    begin
      case Lo (WParam) of
        sb_top        : iHscrollInc := -iHscrollPos;
        sb_bottom     : iHscrollInc := iHscrollMax - iHscrollPos;
        sb_lineup     : iHscrollInc := - iHscrollStep;
        sb_linedown   : iHscrollInc := + iHscrollStep;
        sb_pageup     : iHscrollInc := - max (1, rc.right);
        sb_pagedown   : iHscrollInc :=   max (1, rc.right);
        sb_thumbtrack : iHscrollInc := Hi(WParam) - iHscrollPos;
        else iHscrollInc := 0;
      end;
      iHscrollInc := max (-iHscrollPos,  min(iHscrollInc, iHscrollMax - iHscrollPos));
      if iHscrollInc <> 0
      then begin
             iHscrollPos := iHscrollPos + iHscrollInc;
             ScrollWindow  (window, -iHscrollInc, 0, prc^, prc^);
             SetScrollPos  (Window, sb_horz, iHscrollPos, true);
             UpdateWindow(window);
           end;
    end;
  end;

procedure GetScrollPos (var iHscroll, iVScroll : integer; const ScrollInf : ScrollInfoEx);
  begin
    iHscroll := ScrollInf.iHscrollPos;
    iVScroll := ScrollInf.iVscrollPos;
  end;

procedure SetScrollStep (iHStep, iVStep : integer; var ScrollInf : ScrollInfoEx);
  begin
    if iHStep >= 0
    then ScrollInf.iHscrollStep := iHStep;
    if iVStep >= 0
    then ScrollInf.iVScrollStep := iVStep;
  end;

begin

end.

