// =====================================================
//
//   miniLA_win - Scrollbar with cursors
//
//   (c) miniLA Team
//
//   note:
//      Original code from WAISS (TWOwnrScrllBar v0.1)
//
// =====================================================
//
// This is free software; you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation; either version 2, or (at your option)
// any later version.
//
// This software is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
// GNU General Public License for more details.
//
// You should have received a copy of the GNU General Public License
// along with this package; see the file COPYING.  If not, write to
// the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
// Boston, MA 02111-1307, USA.

unit WOwnrScrllBar;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;

type
  TOSBKind = (osbVertical,osbHorizontal);
  TOSBDrawStyle = (osbStandard,osbOwnerDraw);
  TOSBArea = (osbNone, osbArrowDown, osbArrowUp, osbTrackDown, osbTrackUp, osbScroller);
  TOSBMouseCoords = record x,y : integer; end;

  TOSBEvent = procedure(Sender: TObject;Rect: TRect; State: Boolean) of Object;
  TOSBCursor = record pos:int64;color:tcolor; end;

  TWOwnrScrllBar = class(TCustomControl)
  private
    { Private declarations }
  protected
    { Protected declarations }
     bCtrl3d,mdown:boolean;
     fButSize:integer;
     fPageSize:int64;
     fPageSizePx:integer;
     fMin,fMax,fPosition:int64;
     tKind:TOSBKind;
     tDrawstyle:TOSBDrawStyle;
     iTrack:int64;
     fLastMouse:TOSBMouseCoords;
     fSmallChange:int64;
     fLargeChange:int64;

     fOnChange:TNotifyEvent;
     FTopDraw : TOSBEvent;
     FTrackDraw : TOSBEvent;
     FBottomDraw : TOSBEvent;
     fSelArea : TOSBArea;
     FScrollTimer: TTimer;
     fCursors: array[0..2] of TOSBCursor;

     procedure FireTopDraw(Rect: TRect; State: Boolean);
     procedure FireTrackDraw(Rect: TRect; State: Boolean);
     procedure FireBottomDraw(Rect: TRect; State: Boolean);
     procedure DoScrollTimer(Sender: TObject);
     procedure DoChange;virtual;


     Procedure SetMin(amin: int64);
     Procedure SetMax(amax: int64);
     procedure SetPageSize(apage: int64);
     procedure SetPosition(apos: int64);
     procedure SetKind(Value: TOSBKind);
     procedure SetParams(apos,amin,amax,apage: int64);

     function  TrackRatio:single;
     Procedure HMouse(X, Y: Integer; SetArea : boolean; Act: boolean);

  public
     { Public declarations }
     property Canvas;
     function TrackRect:Trect;
     constructor Create(AOwner: TComponent); override;
     destructor  Destroy; override;
  published
    { Published declarations }
    Property DrawStyle:TOSBDrawStyle read tDrawstyle write tDrawstyle;
    Property Align;
    Property Enabled;
    Property Visible;
    Property Hint;
    Property ShowHint;
    Property Cursor;
    Property PopupMenu;


    Property Ctrl3D:boolean read bCtrl3d write bCtrl3d;
    Property ButtonSize:integer read fButsize write fButsize;
    Property Max:int64 read fMax write SetMax;
    Property Min:int64 read fMin write SetMin;
    Property Kind:TOSBKind read tKind write SetKind;
    Property PageSize:int64 read fPageSize write SetPageSize;
    Property Position:int64 read fPosition write setPosition;
    Property SmallChange:Int64 read fSmallChange write fSmallChange;
    Property LargeChange:int64 read fLargeChange write fLargeChange;
    Property OnDragOver;
    Property OnEndDrag;
    Property OnDragDrop;

    Property OnChange:TNotifyEvent read fOnChange write fOnChange;
    Property OnTopDraw:TOSBEvent read fTopDraw write fTopDraw;
    Property OnTrackDraw:TOSBEvent read fTrackDraw write fTrackDraw;
    Property OnBottomDraw:TOSBEvent read fBottomDraw write fBottomDraw;

    Procedure paint;override;
    Procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    Procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    Procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;

    Procedure SetCursorPosition(n:byte; apos:int64);
    Procedure SetCursorColor(n:byte; acolor:tcolor);

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('miniLa', [TWOwnrScrllBar]);
end;

//------------------------------------------------------------------------------
constructor TWOwnrScrllBar.Create(AOwner: TComponent);
begin

   inherited Create(AOwner);
   height := GetSystemMetrics(SM_CYHSCROLL);
   width := 100;
   tKind := osbHorizontal;
   fButSize:=GetSystemMetrics(SM_CXHSCROLL);
   fPageSize:=10;
   fMin := 1;
   fMax := 100;
   fPosition := 50;
   bctrl3d := True;
   fSmallChange := 1;
   fLargeChange := 4;
   fSelArea := osbNone;

   // autorepeat timer
   FScrollTimer := TTimer.Create(Self);
   with FScrollTimer do begin
     Enabled := False;
     Interval := 50;
     OnTimer := DoScrollTimer;
   end;

end;
//------------------------------------------------------------------------------
destructor TWOwnrScrllBar.Destroy;
begin
   inherited destroy;
end;
//------------------------------------------------------------------------------
procedure TWownrScrllBar.paint;
var
  enadd:integer;
  i,x,y:integer;
begin
   if ctrl3d = true then
   begin
      with canvas do
       begin
	 pen.color:=clBtnShadow;
	 moveto(width,0);
	 lineto(0,0);
	 lineto(0,Height-1);
	 pen.color:=clBtnHighlight;
	 lineto(width-1,height-1);
	 lineto(width-1,0);
       end;
   end;

   with canvas do
    begin
      if DrawStyle = osbStandard then
       begin
        if enabled = false then
          enadd := dfcs_inactive
        else
          enadd := 0;

        // horizontal
        if tKind = osbHorizontal then
         begin
          if fSelArea = osbArrowDown then
             drawframecontrol(canvas.handle,rect(1,1,ButtonSize,height-1),dfc_scroll,dfcs_scrollleft+dfcs_flat+enadd)
          else
             drawframecontrol(canvas.handle,rect(1,1,ButtonSize,height-1),dfc_scroll,dfcs_scrollleft+enadd);

          if fSelArea = osbArrowUp then
             drawframecontrol(canvas.handle,rect(width-ButtonSize,1,width-1,height-1),dfc_scroll,dfcs_scrollright+dfcs_flat+enadd)
          else
             drawframecontrol(canvas.handle,rect(width-ButtonSize,1,width-1,height-1),dfc_scroll,dfcs_scrollright+enadd);
         end
        // vertical
        else
         begin
	  if fSelArea = osbArrowDown then
             drawframecontrol(canvas.handle,rect(1,1,width-1,ButtonSize),dfc_scroll,dfcs_scrollup+dfcs_flat+enadd)
          else
             drawframecontrol(canvas.handle,rect(1,1,width-1,ButtonSize),dfc_scroll,dfcs_scrollup+enadd);

          if fSelArea = osbArrowUp then
             drawframecontrol(canvas.handle,rect(1,height-ButtonSize,width-1,height-1),dfc_scroll,dfcs_scrolldown+dfcs_flat+enadd)
          else
             drawframecontrol(canvas.handle,rect(1,1,width-1,ButtonSize),dfc_scroll,dfcs_scrollup+enadd);
         end;

         // scroller
	 if enabled = true then
	    drawframecontrol(canvas.handle,TrackRect, dfc_button,DFCS_BUTTONPUSH);

         // draw cursors
         // horizontal
         if tKind = osbHorizontal then
           for i:=0 to 2 do
            begin
              pen.Color := fCursors[i].color;
              if (fCursors[i].pos>=fmin) and (fCursors[i].pos<=fmax) then
               begin
                 x := ButtonSize+round(TrackRatio*(fCursors[i].pos-min));
                 moveto(x,1);
                 lineto(x,height-1);
               end;
            end
         // vertical
         else
           for i:=0 to 2 do
            begin
              pen.Color := fCursors[i].color;
              if (fCursors[i].pos>=fmin) and (fCursors[i].pos<=fmax) then
               begin
                 y := ButtonSize+round(TrackRatio*(fCursors[i].pos-min));
		 moveto(1,y);
                 lineto(width-1,y);
               end;
            end;
	end

       // owner drawn style
       else
	begin
	  if not(mdown) then
	   if tKind = osbHorizontal then
	    begin
	      firetopdraw(rect(1,1,ButtonSize,height-1),True);
	      fireBottomdraw(rect(width-ButtonSize,1,width-1,height-1),true);
	    end
           else
	    begin
	      firetopdraw(rect(1,1,width-1,ButtonSize),True);
	      fireBottomdraw(rect(1,height-ButtonSize,width-1,height-1),true);
	    end;
	  fireTrackDraw(trackRect,true);
	end;
   end;

end;

//------------------------------------------------------------------------------
procedure TWOwnrScrllBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   if Button = mbLeft then
    begin
      fSelArea := osbNone;
      HMouse(x,y, true, true);
    end;
end;



//------------------------------------------------------------------------------
Procedure TWOwnrScrllBar.MouseMove(Shift: TShiftState; X, Y: Integer);
 var
   s:Single;
   place:integer;
begin
   fLastMouse.x := x;
   fLastMouse.y := y;

   if fSelArea = osbScroller then
    begin
      if tKind = osbHorizontal then
         place := (x-ButtonSize) - iTrack
      else
         place := (y-ButtonSize) - iTrack;
      s:= TrackRatio;
      SetParams(round(place/s),fmin,fmax,fpagesize);
    end
   else if fSelArea <> osbNone then
      HMouse(x,y, false, false);
end;

//------------------------------------------------------------------------------
procedure TWOwnrScrllBar.MouseUp(Button: TMouseButton; Shift: TShiftState;
          X, Y: Integer);
begin
   fSelArea := osbNone;
   FScrollTimer.Enabled := false;
   paint;
end;

//------------------------------------------------------------------------------
procedure TWOwnrScrllBar.DoScrollTimer(Sender: TObject);
begin
   if fSelArea <> osbNone then
      HMouse(fLastMouse.x, fLastMouse.y, false, true);
end;


//------------------------------------------------------------------------------
procedure TWOwnrScrllBar.HMouse(X, Y: Integer; SetArea: boolean; Act: boolean);
 var
   pt:Tpoint;
   tr:TRect;
   cArea : TOSBArea;
   npos: int64;

begin
   pt.x:=x;
   pt.y:=y;
   tr := TrackRect;

   cArea := osbNone;

   // handle new cursor area

   // out of canvas (when moving with pressed button)
   if (y < 0) or (y > height-1) or (x < 0) or (x > width-1) then
      cArea := osbNone

   // horizontal mode
   else if (tKind = osbHorizontal) then
    begin
      // left arrow
      if (x < ButtonSize) then
       begin
         cArea := osbArrowDown;
       end
      // right arrow
      else if (x > width - ButtonSize) then
       begin
         cArea := osbArrowUp;
       end
      else
       begin

         // scroller
	 if ptinrect(tr,pt) then
          begin
            cArea := osbScroller;
            itrack:=x-tr.left;
          end
	 else
	  begin
            // track left
	    if (x < tr.left) then
	     begin
               cArea := osbTrackDown;
	     end;

            // track right
	    if (x > tr.right) then
	     begin
               cArea := osbTrackUp;
	     end;
	  end;

       end;
    end

   // vertical mode
   else
    begin
      // upper arrow
      if y < ButtonSize then
       begin
	 cArea := osbArrowUp;
       end
      else if y > height - ButtonSize then
       begin
	 cArea := osbArrowDown;
       end
      else
       begin

	 // scroller 
	 if ptinrect(tr,pt) then
	  begin
            cArea := osbScroller;
	    itrack:=y-tr.Top;
	  end
	 else
	  begin
	    // track up
	    if y < tr.top then 
               cArea := osbTrackUp;
	       
	    // track down
	    if y > tr.bottom then 
               cArea := osbTrackDown;
	  end;

       end;
    end;


   // deactivate previously active area
   if (cArea <> fSelArea) and (fSelArea <> osbNone) then
    begin
      // horizontal mode
      if tKind = osbHorizontal then
       begin
         if (fSelArea = osbArrowDown) then
          begin
            if DrawStyle = osbStandard then
	       drawframecontrol(canvas.handle,rect(1,1,ButtonSize,height-1), dfc_scroll,dfcs_scrollleft)
            else
               firetopdraw(rect(1,1,ButtonSize,height-1),false);
          end;

         if (fSelArea = osbArrowUp) then
          begin
            if DrawStyle = osbStandard then
               drawframecontrol(canvas.handle,rect(width-ButtonSize,1,width-1,height-1), dfc_scroll,dfcs_scrollright)
            else
               fireBottomdraw(rect(width-ButtonSize,1,width-1,height-1),false);
          end;
       end

      // vertical mode
      else
       begin
          begin
         if (fSelArea = osbArrowUp) then
	      drawframecontrol(canvas.handle,rect(1,1,width-1,ButtonSize), dfc_scroll,dfcs_scrollup)
	    else
	      firetopdraw(rect(1,1,width-1,ButtonSize),false);
          end;

         if (fSelArea = osbArrowDown) then
          begin
	    if DrawStyle = osbStandard then
	       drawframecontrol(canvas.handle,rect(1,height-ButtonSize,width-1,height-1), dfc_scroll,dfcs_scrolldown)
	    else
	       fireBottomdraw(rect(1,height-ButtonSize,width-1,height-1),false);
          end;
       end
    end;

   // remember selected area
   if SetArea then
    begin
      fSelArea := cArea;
      if (fSelArea = osbArrowDown) or (fSelArea = osbArrowUp) or
         (fSelArea = osbTrackDown) or (fSelArea = osbTrackUp) then
         FScrollTimer.Enabled := true;
    end;

   // update values if necessary
   if Act and (cArea = fSelArea) then
    begin
      case fSelArea of
         osbArrowDown:
               npos := position - SmallChange;
         osbArrowUp:
               npos := position + SmallChange;
         osbTrackDown:
               npos := position - LargeChange;
         osbTrackUp:
               npos := position + LargeChange;
         else
            npos := position;
      end;

      SetParams(npos,fmin,fmax,fpagesize);
    end;

end;


//------------------------------------------------------------------------------
// number of pixels/1 value
function TWOwnrScrllBar.TrackRatio:single;
var s: single;
begin
   if max=min then
    begin
       fPageSizePx := (width-ButtonSize*2);
       Result := fPageSizePx;
       exit;
    end;

   if tKind = osbHorizontal then
      s := (width-ButtonSize*2)/(max-min)
   else
      s := (height-ButtonSize*2)/(max-min);

   // minimal page size
   if round(s*fPageSize)>=6 then
      fPageSizePx := round(s*fPageSize)
   else
    begin
      fPageSizePx := 6;
      s := s - (fPageSizePx-round(s*fPageSize))/(max-min);
    end;

   result := s;
end;

//------------------------------------------------------------------------------
function TWOwnrScrllBar.TrackRect:Trect;
var
   s:single;
begin
   s:= TrackRatio;
   if tKind = osbHorizontal then
    begin
      result.top:= 1;
      result.left := (ButtonSize+1)+round(s*(position-min));
      result.Bottom := height - 1;
      result.Right := result.left + fPageSizePx;
    end
   else
    begin
      result.top:=(ButtonSize+1)+round(s*(position-min));
      result.left := 1;
      result.Bottom := result.top + fPageSizePx;
      result.Right := width - 1;
    end;

end;


//------------------------------------------------------------------------------
procedure TWOwnrScrllBar.setPosition(apos:int64);
begin
   SetParams(apos, fmin, fmax, fpagesize);
end;

//------------------------------------------------------------------------------
procedure TWOwnrScrllBar.SetKind(Value: TOSBKind);
begin
  if tKind <> Value then
  begin
    tKind := Value;
    Invalidate;
  end;
end;

//------------------------------------------------------------------------------
Procedure TWOwnrScrllBar.SetPageSize(apage: int64);
begin
   SetParams(fposition, fmin, fmax, apage);
end;


//------------------------------------------------------------------------------
procedure TWOwnrScrllBar.SetMin(amin: Int64);
begin
   SetParams(fposition, amin, fmax, fpagesize);
end;

//------------------------------------------------------------------------------
procedure TWOwnrScrllBar.SetMax(amax: Int64);
begin
   SetParams(fposition, fmin, amax, fpagesize);
end;


//------------------------------------------------------------------------------
procedure TWOwnrScrllBar.SetParams(apos, amin, amax, apage: int64);
var
   poschange: boolean;
begin
   {clip values to valid ranges}
   if AMax < AMin then AMax := AMin;
   if APage > AMax-AMin+1 then APage := AMax-AMin+1;
   if APos < AMin then APos := AMin;
   if APage > 1 then
    begin
      if APos > AMax-APage+1 then APos := AMax-APage+1;
    end
   else
      if APos > AMax then APos := AMax;

   // apply changes
   poschange := (apos<>fposition);
   if poschange or (amin<>fmin) or (amax<>fmax) or (fpagesize<>apage) then
   begin
     // erase previous scroller
     if (parent <> nil) and poschange then
      begin
        canvas.brush := parent.brush;
        canvas.fillrect(TrackRect);
      end;

     // set new values
     fPosition := apos;
     fmin := amin;
     fmax := amax;
     fpagesize := apage;

     if (parent <> nil) and poschange then
        paint
     else
        repaint;

     if poschange then
        doChange;
   end;

end;


//------------------------------------------------------------------------------
procedure TWOwnrScrllBar.SetCursorPosition(n:byte; apos: int64);
begin
   if apos <> fCursors[n].pos then
    begin
      fCursors[n].pos := apos;
      invalidate;
    end;
end;

//------------------------------------------------------------------------------
procedure TWOwnrScrllBar.SetCursorColor(n:byte; acolor: TColor);
begin
   if acolor <> fCursors[n].color then
    begin
      fCursors[n].color := acolor;
      invalidate;
    end;
end;

//------------------------------------------------------------------------------
Procedure TWOwnrScrllBar.DoChange;
begin
   if assigned(fOnChange) then
      fonchange(Self);
end;

//------------------------------------------------------------------------------
procedure TWOwnrScrllBar.FireTopDraw(Rect: TRect; State: Boolean);
begin
  if assigned(FTopDraw) then FTopDraw(Self,rect,state);
end;

//------------------------------------------------------------------------------
procedure TWOwnrScrllBar.FireTrackDraw(Rect: TRect; State: Boolean);
begin
   if assigned(FTrackDraw) then FTrackDraw(Self,rect,state);
end;

//------------------------------------------------------------------------------
procedure TWOwnrScrllBar.FireBottomDraw(Rect: TRect; State: Boolean);
begin
   if assigned(FBottomDraw) then FBottomDraw(Self,rect,state);
end;


end.


