unit BarPanel;

interface

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

type
  TBarPanel = class;

  TScrBarProp = class(TPersistent)
  private
    FOwner: TBarPanel;
    FKind: TScrollBarKind;
    FSmallChange: Integer;
    FLargeChange: Integer;
    FMin: Integer;
    FMax: Integer;
    FPageSize: Integer;
    FPosition: Integer;
    FVisible: Boolean;
    FAutoHide: Boolean;
    function GetLargeChange: Integer;
    function GetMax: Integer;
    function GetMin: Integer;
    function GetPageSize: Integer;
    function GetPosition: Integer;
    function GetSmallChange: Integer;
    function GetVisible: Boolean;
    procedure SetLargeChange(const Value: Integer);
    procedure SetMax(const Value: Integer);
    procedure SetMin(const Value: Integer);
    procedure SetPageSize(const Value: Integer);
    procedure SetPosition(const Value: Integer);
    procedure SetSmallChange(const Value: Integer);
    procedure SetVisible(const Value: Boolean);
    function GetAutoHide: Boolean;
    procedure SetAutoHide(const Value: Boolean);
  public
    procedure Assign(Source: TScrBarProp);
    constructor Create(AOwner: TBarPanel; Kind: TScrollBarKind);
    destructor Destroy; override;
  published
    property SmallChange: Integer read GetSmallChange write SetSmallChange default 1;
    property LargeChange: Integer read GetLargeChange write SetLargeChange default 5;
    property Min: Integer read GetMin write SetMin default 0;
    property Max: Integer read GetMax write SetMax default 100;
    property PageSize: Integer read GetPageSize write SetPageSize default 20;
    property Position: Integer read GetPosition write SetPosition default 0;
    property Visible: Boolean read GetVisible write SetVisible default True;
    property AutoHide: Boolean read GetAutoHide write SetAutoHide default True;
  end;

  TBarPanel = class(TPanel)
  private
    FHorzScrollBar: TScrBarProp;
    FVertScrollBar: TScrBarProp;
    FOnHorzScroll: TNotifyEvent;
    FOnVertScroll: TNotifyEvent;
    FOnVertScrolling: TScrollEvent;
    FOnHorzScrolling: TScrollEvent;
    procedure WmHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
    procedure WmVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
    procedure WmScroll(var Msg: TWMScroll; Kind: TScrollBarKind);

    procedure HorzScrolling(ScrollCode: TScrollCode; var ScrollPos: Integer);
    procedure VertScrolling(ScrollCode: TScrollCode; var ScrollPos: Integer);
    procedure HorzScroll;
    procedure VertScroll;

    procedure SetAPIScrollInfo(Kind: TScrollBarKind);
    procedure GetAPIScrollInfo(Kind: TScrollBarKind);
    procedure GetAPIScrollPos(Kind: TScrollBarKind);
    procedure SetAPIScrollPos(Kind: TScrollBarKind);

    procedure SetHorzScrollBar(const Value: TScrBarProp);
    procedure SetVertScrollBar(const Value: TScrBarProp);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure CreateHandle; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    constructor CreateClone(Original: TPanel);
  published
    property HorzScrollBar: TScrBarProp read FHorzScrollBar write SetHorzScrollBar;
    property VertScrollBar: TScrBarProp read FVertScrollBar write SetVertScrollBar;

    property OnHorzScrolling: TScrollEvent read FOnHorzScrolling write FOnHorzScrolling;
    property OnVertScrolling: TScrollEvent read FOnVertScrolling write FOnVertScrolling;
    property OnHorzScroll: TNotifyEvent read FOnHorzScroll write FOnHorzScroll;
    property OnVertScroll: TNotifyEvent read FOnVertScroll write FOnVertScroll;
  end;


implementation


//縦スクロールバーの表示/非表示を返す関数
function VerticalScrollbarVisible(Control: TControl): Boolean;
begin
  with Control do
  if (Width - ClientWidth) >= GetSystemMetrics(SM_CXVSCROLL) then
    Result := True
  else
    Result := False;
end;

//横スクロールバーの表示/非表示を返す関数
function HorizontalScrollbarVisible(Control: TControl): Boolean;
begin
  with Control do
  if (Height - ClientHeight) >= GetSystemMetrics(SM_CXHSCROLL) then
    Result := True
  else
    Result := False;
end;

{ TBarPanel }

constructor TBarPanel.Create(AOwner: TComponent);
begin
  OutputDebugString('Create,inherited前');
  inherited;
  OutputDebugString('Create,inherited後');

  FHorzScrollBar := TScrBarProp.Create(Self, sbHorizontal);
  FVertScrollBar := TScrBarProp.Create(Self, sbVertical);
end;

procedure TBarPanel.CreateHandle;
begin
  OutputDebugString('CreateHandle,inherited前');
  inherited;
  OutputDebugString('CreateHandle,inherited後');

  SetAPIScrollInfo(sbHorizontal);
  SetAPIScrollInfo(sbVertical);
//  GetAPIScrollInfo;
end;

procedure TBarPanel.SetAPIScrollInfo(Kind: TScrollBarKind);
var
  ScrollInfo: TScrollInfo;
begin
  with ScrollInfo do
  begin
    cbSize := SizeOf(TScrollinfo);

    case Kind of
      sbHorizontal:
        if FHorzScrollBar.FVisible then
        begin
          with FHorzScrollBar do
          begin
            fMask := SIF_ALL;
            //-------------------------------
            //↓同じ値が入る場合SetScrollInfoだけでは
            //  表示非表示切り替えが不可能なので
            //  ShowScrollBarを明示的に呼ぶ必要がある
            GetScrollInfo(Self.Handle, SB_HORZ, ScrollInfo);
            if (FMin=nMin) and (FMax=nMax) and
               (FPageSize=nPage) and (FPosition=nPos) then
            begin
              ShowScrollBar(Self.Handle, SB_HORZ, True);
            end;

            nMin := FMin;
            nMax := FMax;
            nPage:= FPageSize;
            nPos := FPosition;

            if FAutoHide then
              fMask:= SIF_ALL
            else
            begin
              fMask := SIF_ALL or SIF_DISABLENOSCROLL;
              ShowScrollBar(Self.Handle, SB_HORZ, True);
            end;

            SetScrollInfo(Self.Handle, SB_HORZ, ScrollInfo, True);

          end;
        end else
        begin
          ShowScrollBar(Self.Handle, SB_HORZ, False);
        end;

      sbVertical:
        if FVertScrollBar.FVisible then
        begin
          with FVertScrollBar do
          begin
            fMask := SIF_ALL;
            GetScrollInfo(Self.Handle, SB_VERT, ScrollInfo);
            if (FMin=nMin) and (FMax=nMax) and
               (FPageSize=nPage) and (FPosition=nPos) then
            begin
              ShowScrollBar(Self.Handle, SB_VERT, True);
            end;

            nMin := FMin;
            nMax := FMax;
            nPage:= FPageSize;
            nPos := FPosition;

            if FAutoHide then
              fMask:= SIF_ALL
            else
            begin
              fMask := SIF_ALL or SIF_DISABLENOSCROLL;
              ShowScrollBar(Self.Handle, SB_VERT, True);
            end;

            SetScrollInfo(Self.Handle, SB_VERT, ScrollInfo, True);
          end;
        end else
        begin
          ShowScrollBar(Self.Handle, SB_VERT, False);
        end;
    end; //case


  end; //with
end;

procedure TBarPanel.GetAPIScrollInfo(Kind: TScrollBarKind);
var
  ScrollInfo: TScrollInfo;
begin
  with ScrollInfo do
  begin
    cbSize := SizeOf(ScrollInfo);
    fMask:= SIF_ALL;

    case Kind of
      sbHorizontal:
        with FHorzScrollBar do
        begin
          GetScrollInfo(Self.Handle, SB_HORZ, ScrollInfo);
          FMin := nMin;
          FMax := nMax;
          FPageSize := nPage;
          FPosition := nPos;
        end;

      sbVertical:
        with FVertScrollBar do
        begin
          GetScrollInfo(Self.Handle, SB_VERT, ScrollInfo);
          FMin := nMin;
          FMax := nMax;
          FPageSize := nPage;
          FPosition := nPos;
        end;

    end; //case
  end; //with
end;

procedure TBarPanel.GetAPIScrollPos(Kind: TScrollBarKind);
begin
  case Kind of
    sbHorizontal:
      FHorzScrollBar.FPosition := GetScrollPos(Self.Handle, SB_HORZ);

    sbVertical:
      FVertScrollBar.FPosition := GetScrollPos(Self.Handle, SB_VERT);
  end;
end;

procedure TBarPanel.SetAPIScrollPos(Kind: TScrollBarKind);
begin
  case Kind of
    sbHorizontal:
      SetScrollPos(Self.Handle, SB_HORZ, FHorzScrollBar.FPosition, True);
    sbVertical:
      SetScrollPos(Self.Handle, SB_VERT, FVertScrollBar.FPosition, True);
  end;
end;

procedure TBarPanel.CreateWnd;
begin
  OutputDebugString('CreateWnd,inherited前');
  inherited;
  OutputDebugString('CreateWnd,inherited後');
end;

procedure TBarPanel.CreateParams(var Params: TCreateParams);
begin
  OutputDebugString('CreateParams,inherited前');
  inherited;
  OutputDebugString('CreateParams,inherited後');
end;
//CreateWindowHandle メソッドは，コントロールを表す Windows コントロールを作成します。

procedure TBarPanel.CreateWindowHandle(const Params: TCreateParams);
begin
  OutputDebugString('CreateWindowHandle,inherited前');
  inherited;
  OutputDebugString('CreateWindowHandle,inherited後');
end;


constructor TBarPanel.CreateClone(Original: TPanel);
var
  MemStream: TMemoryStream;
begin
  Create(Original.Owner);
  Self.Parent := Original.Parent;

  MemStream := TMemoryStream.Create;
  try
    MemStream.WriteComponent(Original);
    Original.Free;
    MemStream.Position := 0;
    MemStream.ReadComponent(Self);

  finally
    MemStream.Free;
  end;
end;

destructor TBarPanel.Destroy;
begin
  inherited;
  FHorzScrollBar.Free;
  FVertScrollBar.Free;
end;

//横スクロールメッセージ
procedure TBarPanel.WmHScroll(var Msg: TWMHScroll);
begin
  WmScroll(Msg, sbHorizontal);
end;


//縦スクロールメッセージ
procedure TBarPanel.WmVScroll(var Msg: TWMVScroll);
begin
  WmScroll(Msg, sbVertical);
end;

procedure TBarPanel.WmScroll(var Msg: TWMScroll; Kind: TScrollBarKind);
var
  nPos,nBar, nSmallChange, nLargeChange, nNewPos: integer;
  ScrCode: TScrollCode;
  hWindow: HWND;
begin
  if csDesigning in Self.ComponentState then Exit;

  hWindow := Self.Handle;

  case Kind of
    sbHorizontal:
    begin
      nBar := SB_HORZ;
      nSmallChange := FHorzScrollBar.SmallChange;
      nLargeChange := FHorzScrollBar.LargeChange;
    end;

    sbVertical:
    begin
      nBar := SB_VERT;
      nSmallChange := FVertScrollBar.SmallChange;
      nLargeChange := FVertScrollBar.LargeChange;
    end;
  else
    Assert(False, '');
    Exit;
  end;

  nPos := GetScrollPos(hWindow, nBar);

  case Msg.ScrollCode of

    SB_LINEDOWN:
    begin
      ScrCode := scLineDown;
      nNewPos := nPos + nSmallChange;
    end;

    SB_LINEUP:
    begin
      ScrCode := scLineUp;
      nNewPos := nPos - nSmallChange;
    end;

    SB_PAGEDOWN:
    begin
      ScrCode := scPageDown;
      nNewPos := nPos + nLargeChange;
    end;

    SB_PAGEUP:
    begin
      ScrCode := scPageUp;
      nNewPos := nPos - nLargeChange;
    end;

    SB_THUMBPOSITION:
    begin
      ScrCode := scPosition;
      nNewPos := Msg.Pos;
    end;

    SB_THUMBTRACK:
    begin
      ScrCode := scTrack;
      nNewPos := Msg.Pos;
    end;

    SB_TOP: //キーボードメッセージ
    begin
      ScrCode := scTop;
      nNewPos := Msg.Pos;
    end;

    SB_BOTTOM: //キーボードメッセージ
    begin
      ScrCode := scBottom;
      nNewPos := Msg.Pos;
    end;

    SB_ENDSCROLL:
    begin
      ScrCode := scEndScroll;
      case Kind of
        sbHorizontal: HorzScrolling(ScrCode, nNewPos);
        sbVertical  : VertScrolling(ScrCode, nNewPos);
      end;
      Exit;
    end;
  else
    Assert(False,'');
    Exit;
  end;

  case Kind of
    sbHorizontal:
    begin
      HorzScrolling(ScrCode, nNewPos);
      FHorzScrollBar.Position := nNewPos;

      SetScrollPos(hWindow, nBar, nNewPos, True);

      HorzScroll;
    end;

    sbVertical:
    begin
      VertScrolling(ScrCode, nNewPos);
      FVertScrollBar.Position := nNewPos;

      SetScrollPos(hWindow, nBar, nNewPos, True);

      VertScroll;
    end;
  end;


  inherited;
end;

procedure TBarPanel.HorzScroll;
begin
  if Assigned(FOnHorzScroll) then
  begin
    FOnHorzScroll(Self);
  end;
end;

procedure TBarPanel.VertScroll;
begin
  if Assigned(FOnVertScroll) then
  begin
    FOnVertScroll(Self);
  end;
end;

procedure TBarPanel.HorzScrolling(ScrollCode: TScrollCode;
  var ScrollPos: Integer);
begin
  if Assigned(FOnHorzScrolling) then
  begin
    FOnHorzScrolling(Self, ScrollCode, ScrollPos);
  end;
end;

procedure TBarPanel.VertScrolling(ScrollCode: TScrollCode;
  var ScrollPos: Integer);
begin
  if Assigned(FOnVertScrolling) then
  begin
    FOnVertScrolling(Self, ScrollCode, ScrollPos);
  end;
end;
////////////////////////////////////////////////////////////



procedure TBarPanel.SetHorzScrollBar(const Value: TScrBarProp);
begin
  FHorzScrollBar.Assign(Value);
end;

procedure TBarPanel.SetVertScrollBar(const Value: TScrBarProp);
begin
  FVertScrollBar.Assign(Value);
end;

{ TScrBarProp }


procedure TScrBarProp.Assign(Source: TScrBarProp);
begin
  Visible := Source.Visible;
  SmallChange := Source.SmallChange;
  LargeChange := Source.LargeChange;
  Min := Source.Min;
  Max := Source.Max;
  PageSize := Source.PageSize;
  Position := Source.Position;
end;

constructor TScrBarProp.Create(AOwner: TBarPanel; Kind: TScrollBarKind);
begin
  if Assigned(AOwner)=False then
    raise EComponentError.Create('初期化エラー');

  inherited Create;
  FOwner := AOwner;
  FKind := Kind;
  FMin := 0;
  FMax := 100;
  FLargeChange := 5;
  FSmallChange := 1;
  FPosition := 0;
  FPageSize := 20;
  FVisible := True;
  FAutoHide := True;
end;

destructor TScrBarProp.Destroy;
begin
  inherited;
end;

function TScrBarProp.GetLargeChange: Integer;
begin
  Result := FLargeChange;
end;

function TScrBarProp.GetSmallChange: Integer;
begin
  Result := FSmallChange;
end;

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

function TScrBarProp.GetMin: Integer;
begin
  Result := FMin;
end;

function TScrBarProp.GetPageSize: Integer;
begin
  Result := FPageSize;
end;

function TScrBarProp.GetPosition: Integer;
begin
  if Visible then
    FOwner.GetAPIScrollPos(FKind);
  Result := FPosition;
end;

function TScrBarProp.GetVisible: Boolean;
begin
  Result := FVisible;
end;

function TScrBarProp.GetAutoHide: Boolean;
begin
  Result := FAutoHide;
end;


procedure TScrBarProp.SetLargeChange(const Value: Integer);
begin
  if FLargeChange <> Value then
  begin
    FLargeChange := Value;
  end;
end;

procedure TScrBarProp.SetSmallChange(const Value: Integer);
begin
  if FSmallChange <> Value then
  begin
    FSmallChange := Value;
  end;
end;

procedure TScrBarProp.SetMax(const Value: Integer);
begin
  if FMax <> Value then
  begin
    FMax := Value;
    FOwner.SetAPIScrollInfo(FKind);
  end;
end;

procedure TScrBarProp.SetMin(const Value: Integer);
begin
  if FMin <> Value then
  begin
    FMin := Value;
    FOwner.SetAPIScrollInfo(FKind);
  end;
end;

procedure TScrBarProp.SetPageSize(const Value: Integer);
begin
  if FPageSize <> Value then
  begin
    FPageSize := Value;
    FOwner.SetAPIScrollInfo(FKind);
  end;
end;

procedure TScrBarProp.SetPosition(const Value: Integer);
begin
  if FPosition <> Value then
  begin
    FPosition := Value;
    FOwner.SetAPIScrollPos(FKind);
  end;
end;

procedure TScrBarProp.SetVisible(const Value: Boolean);
begin
  if FVisible <> Value then
  begin
    FVisible := Value;
    FOwner.SetAPIScrollInfo(FKind);
  end;
end;

procedure TScrBarProp.SetAutoHide(const Value: Boolean);
begin
  if FAutoHide <> Value then
  begin
    FAutoHide := Value;
    FOwner.RecreateWnd;
  end;
end;

end.