unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, GIFImg, jpeg;

type
  TplScrollBox = class(Forms.TScrollBox)
  protected
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure Resize; override;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  private
    { Private 宣言 }
    plScrollBox1 : TplScrollBox;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム作成時の処理
//  TScrollBoxの派生コンポーネントを生成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  plScrollBox1 := TplScrollBox.Create(Self);
  plScrollBox1.Parent := Self;
  plScrollBox1.Align  := alClient;

  Image1.Parent := plScrollBox1;
  Image1.Left := 10;
  Image1.Top  := 20;
end;

//=============================================================================
//  Form1のOnMouseWheelイベント
//  スクロールボックスをマウスホイールでスクロールさせる
//=============================================================================
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  SB1 : TScrollBox;
begin
  SB1 := plScrollBox1;
  if FindVCLWindow(MousePos) = SB1 then begin
    Handled := True;
    SB1.VertScrollBar.Position := SB1.VertScrollBar.Position - WheelDelta div 5;
  end;
end;

{ TplScrollBox }

//=============================================================================
//  TplScrollBoxのResizeメソッド
//  リサイズされると自動的に実行されるメソッド
//  OnResizeイベントに相当する
//=============================================================================
procedure TplScrollBox.Resize;
var
  i           : Integer;
  LBottom     : Integer;
  LScrollInfo : TScrollInfo;
begin
  inherited;

  //TScrollBox内に配置しているコントロールの表示高さを計算
  LBottom := 0;
  for i := 0 to ControlCount - 1 do begin
    if LBottom <= (Controls[i].Top + Controls[i].Height) then begin
      LBottom := Controls[i].Top + Controls[i].Height;
    end;
  end;
  //下方に少しマージンをとってみる
  LBottom := LBottom + 30;
  VertScrollBar.Range := LBottom;

  if LBottom < ClientHeight then begin
    EnableScrollBar(Handle, SB_VERT, ESB_DISABLE_BOTH);
  end else begin
    EnableScrollBar(Handle, SB_VERT, ESB_ENABLE_BOTH);
  end;
end;

//=============================================================================
//  WM_NCCALCSIZEメッセージ処理
//  縦スクロールバー(WS_VSCROLL)を強制的に表示するスタイルに変更
//=============================================================================
procedure TplScrollBox.WMNCCalcSize(var Message: TWMNCCalcSize);
var
  LStyle: Integer;
begin
  LStyle := GetWindowLong(Handle, GWL_STYLE);
  SetWindowLong(Handle, GWL_STYLE, LStyle or WS_VSCROLL);

  //スクロールバーの表示を更新
  Resize;

  inherited;
end;

end.

  ScrollBox1.HorzScrollBar.Visible := False;  //水平スクロールバーを常に非表示
  ScrollBox1.VertScrollBar.Visible := False;  //垂直スクロールバーを常に非表示

procedure TplScrollBox.WMNCCalcSize(var Message: TWMNCCalcSize);
var
  LStyle: Integer;
begin
  LStyle := GetWindowLong(Handle, GWL_STYLE);
  SetWindowLong(Handle, GWL_STYLE, LStyle and not WS_VSCROLL);

  //スクロールバーの表示を更新
  Resize;

  inherited;
end;

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, GIFImg, jpeg;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  水平方向のスクロールのトラッキングのON,OFF切り換え
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  ScrollBox1.HorzScrollBar.Tracking := not ScrollBox1.HorzScrollBar.Tracking;
end;

//=============================================================================
//  垂直方向のスクロールのトラッキングのON,OFF切り換え
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  ScrollBox1.VertScrollBar.Tracking := not ScrollBox1.VertScrollBar.Tracking;
end;

end.

procedure TplScrollBox.WMContextMenu(var Message: TWMContextMenu);
var
  LPos : TPoint;
begin
  LPos := ScreenToClient(Point(Message.XPos, Message.YPos));
  if PtInRect(ClientRect, LPos) then begin
    inherited;
  end else begin
    Message.Result := 0;
  end;
end;