source: tags/1.3.6/LocalPlayer/PVSB.pas

{$INCLUDE Switches.inc}
unit PVSB;

interface

uses
  {$IFDEF WINDOWS}Windows,{$ENDIF}
  Classes, LCLIntf, LCLType, LMessages, Messages, SysUtils, Math,
  {$IFDEF DPI}Dpi.Controls, Dpi.Forms, Dpi.StdCtrls{$ELSE}
  Controls, Forms, StdCtrls{$ENDIF};

type

  { TPVScrollbar }

  TPVScrollBar = class
  private
    FOnUpdate: TNotifyEvent;
    FMax: Integer;
    function GetMax: Integer;
    function GetPageSize: Integer;
    function GetPosition: Integer;
    procedure ScrollBarChanged(Sender: TObject);
    procedure SetMax(AValue: Integer);
    procedure SetPageSize(AValue: Integer);
    procedure SetPosition(AValue: Integer);
  public
    ScrollBar: TScrollBar;
    WheelSteps: Integer;
    constructor Create(Parent: TWinControl);
    destructor Destroy; override;
    procedure Init(Max, PageSize: Integer);
    procedure SetPos(Pos: Integer);
    function Process(const Msg: TMessage): Boolean;
    function ProcessMouseWheel(Delta: Integer): Boolean;
    procedure Show(Visible: Boolean);
    procedure EndSB;
    procedure SetBorderSpacing(Top, Right, Bottom: Integer);
    property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
    property Position: Integer read GetPosition write SetPosition;
    property Max: Integer read GetMax write SetMax;
    property PageSize: Integer read GetPageSize write SetPageSize;
  end;


implementation

const
  Count: Integer = 0;

procedure TPVScrollBar.Init(Max, PageSize: Integer);
begin
  ScrollBar.PageSize := PageSize;
  ScrollBar.Min := 0;
  Self.Max := Max;
  ScrollBar.Position := 0;
  {$IFDEF UNIX}
  ScrollBar.Visible := Max > ScrollBar.PageSize;
  {$ELSE}
  ScrollBar.Visible := Max >= ScrollBar.PageSize;
  {$ENDIF}
end;

procedure TPVScrollBar.SetPos(Pos: Integer);
begin
  if Pos <> 0 then begin
    ScrollBar.Position := Pos;
  end;
end;

function TPVScrollBar.Process(const Msg: TMessage): Boolean;
var
  NewPos: Integer;
begin
    if Max < ScrollBar.PageSize then
      Result := False
    else
    begin
      if (Msg.wParam and $ffff) in [SB_THUMBPOSITION, SB_THUMBTRACK] then
      begin
        Result := ((Msg.wParam shr 16) and $ffff) <> ScrollBar.Position;
        ScrollBar.Position := (Msg.wParam shr 16) and $ffff;
      end else begin
        case (Msg.wParam and $ffff) of
          SB_LINEUP:
            NewPos := ScrollBar.Position - 1;
          SB_LINEDOWN:
            NewPos := ScrollBar.Position + 1;
          SB_PAGEUP:
            NewPos := ScrollBar.Position - ScrollBar.PageSize;
          SB_PAGEDOWN:
            NewPos := ScrollBar.Position + ScrollBar.PageSize;
        else
          NewPos := ScrollBar.Position
        end;
        if NewPos < 0 then
          NewPos := 0;
        if NewPos > Max - ScrollBar.PageSize + 1 then
          NewPos := Max - ScrollBar.PageSize + 1;
        Result := NewPos <> ScrollBar.Position;
        if (NewPos <> ScrollBar.Position) or ((Msg.wParam and $ffff) = SB_ENDSCROLL) then
        begin
          ScrollBar.Position := NewPos;
        end;
      end;
    end;
end;

function TPVScrollBar.ProcessMouseWheel(Delta: Integer): Boolean;
var
  NewPos: Integer;
begin
  if Max < ScrollBar.PageSize then Result := False
  else begin
    NewPos := ScrollBar.Position - Delta div (120 div WheelSteps);
    if NewPos < 0 then NewPos := 0;
    if NewPos > Max - ScrollBar.PageSize + 1 then
      NewPos := Max - ScrollBar.PageSize + 1;
    Result := NewPos <> ScrollBar.Position;
    if NewPos <> ScrollBar.Position then begin
      ScrollBar.Position := NewPos;
    end;
  end;
end;

procedure TPVScrollBar.Show(Visible: Boolean);
begin
  if not Visible or (Max < ScrollBar.PageSize) then
    ScrollBar.Visible := False
    else ScrollBar.Visible := True;
end;

procedure TPVScrollBar.EndSB;
begin
  if Max < ScrollBar.PageSize then
    ScrollBar.Position := 0 // hidden
  else begin
    ScrollBar.Position := Max - ScrollBar.PageSize + 1;
  end;
end;

procedure TPVScrollBar.SetBorderSpacing(Top, Right, Bottom: Integer);
begin
  ScrollBar.BorderSpacing.Top := Top;
  ScrollBar.BorderSpacing.Right := Right;
  ScrollBar.BorderSpacing.Bottom := Bottom;
end;

{ TPVScrollbar }

procedure TPVScrollBar.ScrollBarChanged(Sender: TObject);
begin
  if Assigned(FOnUpdate) then FOnUpdate(Self);
end;

procedure TPVScrollBar.SetMax(AValue: Integer);
begin
  FMax := AValue;
  ScrollBar.Max := Math.Max(0, FMax);
end;

procedure TPVScrollBar.SetPageSize(AValue: Integer);
begin
  ScrollBar.PageSize := AValue;
end;

function TPVScrollBar.GetPosition: Integer;
begin
  Result := ScrollBar.Position;
end;

function TPVScrollBar.GetMax: Integer;
begin
  Result := FMax;
end;

function TPVScrollBar.GetPageSize: Integer;
begin
  Result := ScrollBar.PageSize;
end;

procedure TPVScrollBar.SetPosition(AValue: Integer);
begin
  ScrollBar.Position := AValue;
end;

constructor TPVScrollBar.Create(Parent: TWinControl);
begin
  Inc(Count);
  ScrollBar := TScrollBar.Create(Parent);
  ScrollBar.Kind := TScrollBarKind.sbVertical;
  ScrollBar.Name := 'PVSB' + IntToStr(Count);
  ScrollBar.Align := TAlign.alRight;
  ScrollBar.OnChange := ScrollBarChanged;
  ScrollBar.Parent := Parent;
  ScrollBar.Width := 16;
  WheelSteps := 4;
end;

destructor TPVScrollBar.Destroy;
begin
  FreeAndNil(ScrollBar);
end;

end.