{=============================================================================
 unit Scroll32

 TScrollbar32 is the 32 bit version of the 16 bit TScrollbar that comes with
 Delphi 2. It is backward compatible with the 16 bit TScrollbar.

 The following features have been added:

 1) Position, Max and Min are 32 bit integers
 2) SmallChange and LargeChange are unsigned 32 bit integers (cardinals)
 3) extra property PageSize. This determines the size of the thumb. Its value
		can range from 0 to Max-Min+1. Default is 0, which gives the 'classical'
		behaviour and appearance. The maximum value of the Position property is
		Max-PageSize+1.
 4) extra public method:
				SetParams32(APosition, AMin, AMax: Integer; APage: Cardinal)
		This method is much like the 'old' SetParams, which is still present for
		backward compatibility, but contains the extra PageSize parameter.

 =============================================================================}
unit Scroll32;

interface

uses Classes, Controls, Messages, Forms, StdCtrls, Windows, ExtCtrls;


type
//== TScrollbar32 =============================================================
	TScrollBar32Inc = 1..2147483647;
	TScrollbar32 = class(TWinControl)
	private
		FKind       : TScrollBarKind;
		FPageSize   : Cardinal;
		FPosition   : Integer;
		FMin        : Integer;
		FMax        : Integer;
		FSmallChange: TScrollBar32Inc;
		FLargeChange: TScrollBar32Inc;
		FOnChange   : TNotifyEvent;
		FOnScroll   : TScrollEvent;
		procedure DoScroll(var Message: TWMScroll);
		procedure SetKind(Value: TScrollBarKind);
		procedure SetMax(Value: Integer);
		procedure SetMin(Value: Integer);
		procedure SetPageSize(Value: Cardinal);
		procedure SetPosition(Value: Integer);
		procedure CNHScroll(var Message: TWMHScroll); message CN_HSCROLL;
    procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL;
  protected
		procedure CreateParams(var Params: TCreateParams); override;
		procedure CreateWnd; override;
		procedure Change; dynamic;
		procedure Scroll(ScrollCode: TScrollCode; var Pos: Integer); dynamic;
	public
		constructor Create(AOwner: TComponent); override;
		procedure SetParams(APosition, AMin, AMax: Integer);
		procedure SetParams32(APosition, AMin, AMax: Integer; APage: Cardinal);
		procedure SetCursorPosition(Value: Integer);
	published
		property Ctl3D;
		property DragCursor;
		property DragMode;
		property Enabled;
		property Kind: TScrollBarKind read FKind write SetKind default sbHorizontal;
		property LargeChange: TScrollBar32Inc read FLargeChange write FLargeChange default 1;
		property Max: Integer read FMax write SetMax default 100;
		property Min: Integer read FMin write SetMin default 0;
		property PageSize: Cardinal read FPageSize write SetPageSize default 0;
		property ParentCtl3D;
		property ParentShowHint;
		property PopupMenu;
		property Position: Integer read FPosition write SetPosition default 0;
		property ShowHint;
		property SmallChange: TScrollBar32Inc read FSmallChange write FSmallChange default 1;
		property TabOrder;
		property TabStop default True;
		property Visible;
		property OnChange: TNotifyEvent read FOnChange write FOnChange;
		property OnDragDrop;
		property OnDragOver;
		property OnEndDrag;
		property OnEnter;
		property OnExit;
		property OnKeyDown;
		property OnKeyPress;
		property OnKeyUp;
		property OnScroll: TScrollEvent read FOnScroll write FOnScroll;
		property OnStartDrag;
	end;

procedure Register;

//*****************************************************************************
implementation

uses Consts;

//== TScrollbar32 =============================================================
constructor TScrollbar32.Create(AOwner: TComponent);
begin
	inherited create(AOwner);
	FKind        := sbHorizontal;
	Width        := 121;
	Height       := GetSystemMetrics(SM_CYHSCROLL);
	ControlStyle := [csFramed, csDoubleClicks];
	TabStop      := True;
	FPosition    := 0;
	FMin         := 0;
	FMax         := 100;
	FSmallChange := 1;
	FLargeChange := 1;
	FPageSize    := 0;    {this gives the classical thumb}
end;

procedure TScrollbar32.CreateParams(var Params: TCreateParams);
const
  Kinds: array[TScrollBarKind] of LongInt = (SBS_HORZ, SBS_VERT);
begin
  inherited CreateParams(Params);
  CreateSubClass(Params, 'SCROLLBAR');
  with Params do Style := Style or Kinds[FKind];
end;

procedure TScrollbar32.CreateWnd;
var
	ScrollInfo: TScrollInfo;
begin
	inherited CreateWnd;
	ScrollInfo.cbSize := Sizeof (ScrollInfo);
	ScrollInfo.fMask  := SIF_PAGE or SIF_POS or SIF_RANGE;
	ScrollInfo.nPage  := FPageSize;
	ScrollInfo.nMin   := FMin;
	ScrollInfo.nMax   := FMax;
	ScrollInfo.nPos   := FPosition;
	SetScrollInfo (Handle, SB_CTL, ScrollInfo, True);
end;

procedure TScrollbar32.SetCursorPosition(Value: Integer);
begin
    setPosition( Value );
end;

procedure TScrollbar32.SetKind(Value: TScrollBarKind);
begin
	if FKind <> Value then begin
    FKind := Value;
		if not (csLoading in ComponentState) then SetBounds(Left, Top, Height, Width);
    RecreateWnd;
  end;
end;

procedure TScrollbar32.SetParams(APosition, AMin, AMax: Integer);
begin
	SetParams32(APosition, AMin, AMax, FPageSize);
end;

procedure TScrollbar32.SetParams32(APosition, AMin, AMax: Integer; APage: Cardinal);
var
	ScrollInfo: TScrollInfo;
begin
	{clip values to valid ranges}
	if AMax < AMin then AMax := Amin;
	if APage > AMax-AMin+1 then APage := AMax-AMin+1;
	if APosition < AMin then APosition := AMin;
	if APage > 1 then begin
		if APosition > AMax-APage+1 then APosition := AMax-APage+1;
	end else
		if APosition > AMax then APosition := AMax;
	{set mask for parameters to be changed}
	ScrollInfo.fMask := 0;
	if (FMin <> AMin) or (FMax <> AMax) then
		ScrollInfo.fMask := ScrollInfo.fMask or SIF_RANGE;
	if FPosition <> APosition then
		ScrollInfo.fMask := ScrollInfo.fMask or SIF_POS;
	if FPageSize <> APage then
		ScrollInfo.fMask := ScrollInfo.fMask or SIF_PAGE;
	{change parameters}
	ScrollInfo.cbSize := Sizeof(ScrollInfo);
	ScrollInfo.nPos   := APosition;
	ScrollInfo.nMin   := AMin;
	ScrollInfo.nMax   := AMax;
	ScrollInfo.nPage  := APage;
	if HandleAllocated then SetScrollInfo (Handle, SB_CTL, ScrollInfo, True);
	{remember changes}
	FMin      := AMin;
	FMax      := AMax;
	FPageSize := APage;
	if FPosition <> APosition then begin
		FPosition := APosition;
		Change;
	end;
end;

procedure TScrollbar32.SetPosition(Value: Integer);
begin
	SetParams32(Value, FMin, FMax, FPageSize);
end;

procedure TScrollbar32.SetMin(Value: Integer);
begin
	SetParams32(FPosition, Value, FMax, FPageSize);
end;

procedure TScrollbar32.SetMax(Value: Integer);
begin
	SetParams32(FPosition, FMin, Value, FPageSize);
end;

procedure TScrollbar32.SetPageSize (Value: Cardinal);
begin
	SetParams32(FPosition, FMin, FMax, Value);
end;

procedure TScrollbar32.Change;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TScrollbar32.Scroll(ScrollCode: TScrollCode; var Pos: Integer);
begin
  if Assigned(FOnScroll) then FOnScroll(Self, ScrollCode, Pos);
end;

procedure TScrollbar32.DoScroll(var Message: TWMScroll);
var
	ScrollInfo: TScrollInfo;
	NewPos: Integer;
begin
	with Message do begin
		NewPos := FPosition;
		case TScrollCode(ScrollCode) of
			scLineUp  : Dec(NewPos, FSmallChange);
			scLineDown: Inc(NewPos, FSmallChange);
			scPageUp  : Dec(NewPos, FLargeChange);
			scPageDown: Inc(NewPos, FLargeChange);
			scTrack   : begin
				ScrollInfo.cbSize := Sizeof (ScrollInfo);
				ScrollInfo.fMask := SIF_TRACKPOS;
				GetScrollInfo (Handle, SB_CTL, ScrollInfo);
				NewPos := ScrollInfo.nTrackPos;
			end;
			scTop   : NewPos := FMin;
			scBottom: NewPos := FMax;
		end;
		if NewPos < FMin then NewPos := FMin;
		if FPageSize > 1 then begin
			if NewPos > FMax-FPageSize+1 then NewPos := FMax - FPageSize + 1;
		end else
			if NewPos > FMax then NewPos := FMax;
		Scroll(TScrollCode(ScrollCode), NewPos);
		SetPosition(NewPos);
	end;
end;

procedure TScrollbar32.CNHScroll(var Message: TWMHScroll);
begin
  DoScroll(Message);
end;

procedure TScrollbar32.CNVScroll(var Message: TWMVScroll);
begin
  DoScroll(Message);
end;

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

end.
