program NativeScrollDemo;
{$mode objfpc}{$H+}

uses
  Classes, windows, LazLogger;

var
  ScrollInfo: TScrollInfo;
  WndHandle: HWND;
  lastpos: integer;


function WindowWndProc(Ahwnd: HWND; uMsg: UINT; wParam: WParam; lParam: LParam) : LRESULT; stdcall;
var
  p: Word;
begin
  Result := 0;
  Case uMsg  Of
    WM_DESTROY : PostQuitMessage(0);
    WM_VSCROLL: begin
      p := HIWORD(LongInt(WParam));

      ScrollWindowEx(WndHandle, 0, lastpos - p, nil, nil, 0, nil,
        SW_INVALIDATE or
        SW_ERASE or
        SW_SCROLLCHILDREN
      );
      lastpos := p;

      //ScrollInfo.cbSize := SizeOf(ScrollInfo);
      //ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL and not SIF_TRACKPOS;
      //ScrollInfo.nMin := 1;
      //ScrollInfo.nTrackPos := p;
      //ScrollInfo.nMax := 3000;
      //SetScrollInfo(WndHandle, SB_VERT, ScrollInfo, False);

      Result := 0;
    end;
    Else
      Result := Windows.DefWindowProc(ahwnd, uMsg, wParam, lParam);
  End;
end;



procedure ShowWindow;
Var
  A_Atom : TAtom = 0;
  WndClass : TWndClass;
  Msg: TMsg;
  ScreenWidth, ScreenHeight, MiddleX, MiddleY : LongInt;
  i, j: Integer;
Begin
  lastpos := 0;
  FillChar(WndClass, SizeOf(TWndClass), 0);

  ScreenWidth := GetSystemMetrics(SM_CXSCREEN);
  ScreenHeight := GetSystemMetrics(SM_CYSCREEN);

  MiddleX := (ScreenWidth - 500) Div 2;
  MiddleY := (ScreenHeight - 500) div 2;

  WndClass.lpszClassName:= 'HEAPTRACE_CLASS';
  WndClass.lpfnWndProc :=  @WindowWndProc;

  WndClass.hInstance := hInstance;
  WndClass.hbrBackground:= 1;
  WndClass.style := CS_HREDRAW or CS_VREDRAW;
  WndClass.hCursor := LoadCursor(0, IDC_ARROW);

  A_Atom := RegisterClass(WndClass);

  WndHandle := CreateWindow(
   WndClass.lpszClassName , // lpClassName, optional
   'Foo',
   WS_OVERLAPPEDWINDOW or WS_VISIBLE or WS_VSCROLL , // dwStyle
   MiddleX, // x
   MiddleY, // y
   500, // nWidth
   500, // nHeight
   0, // hWndParent
   0, // hMenu
   WndClass.hInstance, // hInstance
   nil  // lpParam
   );


  ScrollInfo.cbSize := SizeOf(ScrollInfo);
  ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL and not SIF_TRACKPOS;
  ScrollInfo.nMin := 1;
  ScrollInfo.nTrackPos := 0;
  ScrollInfo.nMax := 3000;
  SetScrollInfo(WndHandle, SB_VERT, ScrollInfo, False);


for i := 0 to 50 do
for j := 0 to 3 do begin
  CreateWindow(
   'BUTTON' , // lpClassName, optional
   'OK', // lpWindowName, optional
   WS_TABSTOP or WS_VISIBLE or WS_CHILD or BS_DEFPUSHBUTTON , // dwStyle
   20 + j * 60, // x
   40 + i * 60, // y
   50, // nWidth
   50, // nHeight
   WndHandle, // hWndParent
   0, // hMenu
   WndClass.hInstance, // hInstance
   nil  // lpParam
   );
end;

  BringWindowToTop(WndHandle);

  while GetMessage(Msg,0,0,0) do begin
//DbgOut(',');
    DispatchMessage(Msg);
  end;

  DestroyWindow(WndHandle);

  UnregisterClass(WndClass.lpszClassName, WndClass.hInstance);
end;


begin
  ShowWindow;
end.