How to create a TPanel with scrollbars

Mirror

How to create a TPanel with scrollbars (Views: 710)

Problem/Question/Abstract:

I want to create a component that has scrollbars (vertical/ horizontal). I tried to get the tricks from TCustomGrid but it doesn't work when I try to set a range/ position value to one of the scrollbars.

Answer:

This example uses an interposer class for convenience (mine, I just wanted to avoid the hassle of creating and installing a proper component for this example) but you should be able to adapt it for a proper component.

{ Example for fitting a panel with scrollbars }

unit Unit1;

interface

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

type
  TPanel = class(Extctrls.TPanel)
  private
    procedure WMVScroll(var msg: TWMSCROLL); message WM_VSCROLL;
    procedure WMHScroll(var msg: TWMSCROLL); message WM_HSCROLL;
    procedure WMGetDlgCode(var msg: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure HandleScrollbar(var msg: TWMSCROLL; bar: Integer);
  protected
    procedure CreateParams(var params: TCreateParams); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{ TPanel }

procedure TPanel.CreateParams(var params: TCreateParams);
begin
  inherited;
  params.Style := params.Style or WS_VSCROLL or WS_HSCROLL;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  si: TScrollInfo;
begin
  si.cbSize := Sizeof(TScrollInfo);
  si.fMask := SIF_ALL or SIF_DISABLENOSCROLL;
  si.nMin := 0;
  si.nMax := 3 * panel1.clientheight;
  si.nPage := panel1.clientheight div 2;
  si.nPos := 0;
  SetScrollInfo(panel1.handle, SB_VERT, si, true);
  si.nMax := 2 * panel1.clientwidth;
  si.nPage := panel1.clientwidth div 2;
  SetScrollInfo(panel1.handle, SB_HORZ, si, true);
end;

procedure TPanel.HandleScrollbar(var msg: TWMSCROLL; bar: Integer);
var
  si: TScrollInfo;
begin
  msg.result := 0;
  si.cbSize := Sizeof(TscrollInfo);
  si.fMask := SIF_ALL;
  GetScrollInfo(Handle, bar, si);
  si.fMask := SIF_POS;
  { For simplicities sake we use 1/10 of the page size as small scroll
         increment and the page size as large scroll increment }
  case msg.ScrollCode of
    SB_TOP: si.nPos := si.nMin;
    SB_BOTTOM: si.nPos := si.nMax;
    SB_LINEUP: Dec(si.nPos, si.nPage div 10);
    SB_LINEDOWN: Inc(si.nPos, si.nPage div 10);
    SB_PAGEUP: Dec(si.nPos, si.nPage);
    SB_PAGEDOWN: Inc(si.nPos, si.nPage);
    SB_THUMBTRACK, SB_THUMBPOSITION: si.nPos := msg.Pos;
    SB_ENDSCROLL: Exit;
  end;
  si.fMask := SIF_POS;
  if si.nPos < si.nMin then
    si.nPos := si.nMin;
  if si.nPos > si.nMax then
    si.nPos := si.nMax;
  SetScrollInfo(Handle, bar, si, true);
  { Fire a scroll notification off here to allow client to scroll content of panel }
end;

procedure TPanel.KeyDown(var Key: Word; Shift: TShiftState);

  procedure Scroll(scrollcode, message: Cardinal);
  begin
    Perform(message, scrollcode, 0);
  end;

const
  scrollkind: array[Boolean] of Cardinal = (WM_VSCROLL, WM_HSCROLL);
begin
  inherited;
  { Ignoring shift state for arrow keys here for simplicities sake }
  case Key of
    VK_UP: Scroll(SB_LINEUP, WM_VSCROLL);
    VK_LEFT: Scroll(SB_LINEUP, WM_HSCROLL);
    VK_DOWN: Scroll(SB_LINEDOWN, WM_VSCROLL);
    VK_RIGHT: Scroll(SB_LINEDOWN, WM_HSCROLL);
    VK_NEXT: Scroll(SB_PAGEDOWN, scrollkind[ssCtrl in Shift]);
    VK_PRIOR: Scroll(SB_PAGEUP, scrollkind[ssCtrl in Shift]);
    VK_HOME: Scroll(SB_TOP, scrollkind[ssCtrl in Shift]);
    VK_END: Scroll(SB_BOTTOM, scrollkind[ssCtrl in Shift]);
  end;
  Key := 0;
end;

procedure TPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if (Button = mbLeft) and CanFocus and not Focused then
    SetFocus;
end;

procedure TPanel.WMGetDlgCode(var msg: TWMGetDlgCode);
begin
  msg.result := DLGC_WANTARROWS;
end;

procedure TPanel.WMHScroll(var msg: TWMSCROLL);
begin
  HandleScrollbar(msg, SB_HORZ);
end;

procedure TPanel.WMVScroll(var msg: TWMSCROLL);
begin
  HandleScrollbar(msg, SB_VERT);
end;

end.

<< Back to main page