代碼如下：

program Project2;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  windows,
  Winapi.Messages,
  Vcl.Dialogs;

var
  swndClass: tagWNDCLASS;
  message: MSG;
  mHwnd: hwnd;
  cxChar, cyChar: Integer;
  cxClient, cyClient: Integer;
  ScrollPos: Integer = 0;

function WindowProc(hwnd: hwnd; uMsg: UINT; wParam: wParam; lParam: lParam): LRESULT; stdcall
 
;
var
  i: integer;
  uHdc: HDC;
  ps: tagPAINTSTRUCT;
  tm: tagTEXTMETRIC;
  str: string;
begin
  case uMsg of
    WM_CREATE:
      begin
        {獲取文本尺寸}
        uHdc := GetDC(hwnd);
        GetTextMetrics(uHdc, tm);
        ReleaseDC(hwnd, uHdc);
        cxChar := tm.tmAveCharWidth;
        cyChar :
 
= tm.tmHeight + tm.tmExternalLeading;

        {設置滾動條最大位置}
        SetScrollRange(hwnd, SB_VERT, 0, 100, False);
        SetScrollPos(hwnd, SB_VERT, 20, True);
      end;
    WM_SIZE:
      begin
        cxClient := loword(lParam);
        cyClient := HiWord(lParam);
      end;
    WM_PAINT:
      begin
 

        uHdc := BeginPaint(hwnd, ps);
        for i := ScrollPos to 100 do
        begin
          str := ‘Hello world num:‘ + i.ToString;
          TextOut(uHdc, 0, (i - ScrollPos) * cychar, PWideChar(str), Length(str));
        end;
        EndPaint(hwnd, ps);
      end;
    WM_VSCROLL:
      begin
        case LOWORD(wParam) of
          SB_BOTTOM:
            begin
              {滾動到底端}
              scrollpos := 100;
            end;
          SB_ENDSCROLL:
            begin
             {完成滾動，松開鼠標}
             //scrollpos := hiword(wParam);
            end;
          SB_LINEDOWN:
            begin
              {向下滾動一行}
              Inc(ScrollPos);
            end;
          SB_LINEUP:
            begin
             {向上滾動一行}
              Dec(ScrollPos);
            end;
          SB_PAGEDOWN:
            begin
              {向下滾動一頁}
              scrollpos := scrollpos + (cyclient div cyChar);
            end;
          SB_PAGEUP:
            begin
             {向上滾動一頁}
              scrollpos := scrollpos - (cyclient div cyChar);
            end;
          SB_THUMBPOSITION:
            begin
             {用戶拖動滾動條，且松開鼠標}
              scrollpos := hiword(wParam);
            end;
          SB_THUMBTRACK:
            begin
             {用戶正在拖動滾動條}
              scrollpos := hiword(wParam);
            end;
          sb_top:
            begin
              {滾動條到頂端}
              scrollpos := 0;
            end;

        end;
        {限制最大值，最小值}
        if ScrollPos < 0 then
        begin
          scrollpos := 0;
        end;
        if ScrollPos > 100 then
        begin
          scrollpos := 100;
        end;
        {有改動才更新}
        if ScrollPos <> GetScrollPos(hwnd, SB_VERT) then
        begin
          SetScrollPos(hwnd, SB_VERT, ScrollPos, true);
          InvalidateRect(hwnd, nil, true);
        end;
      end;

  end;
  result := DefWindowProc(hwnd, uMsg, wParam, lParam);
end;

begin
  swndClass.cbClsExtra := 0; //窗口類擴展，無
  swndClass.cbWndExtra := 0; //窗口實例擴展
  swndClass.hbrBackground := COLOR_BACKGROUND; //窗口背景顏色黑色
  //LoadCursor()
  swndClass.hCursor := LoadCursor(0, IDC_ARROW); //窗口采用箭頭光標
  swndClass.hIcon := LoadIcon(0, IDI_APPLICATION); //窗口最小化圖標：采用缺省圖標
  swndClass.hInstance := hInstance; //窗口實例句柄
  swndClass.lpfnWndProc := @WindowProc; //窗口處理函數
  swndClass.lpszClassName := ‘myWnd‘; //窗口類名
  swndClass.lpszMenuName := nil; //窗口菜單
  swndClass.style := CS_DBLCLKS; //窗口樣式
  if RegisterClass(swndClass) = 0 then
  begin
    Writeln(‘windows class register error!‘);
    Exit;
  end;

  mHwnd := CreateWindowEx(0, ‘myWnd‘, ‘Delphi Windows‘, WS_OVERLAPPEDWINDOW or WS_VSCROLL or WS_HSCROLL,  {滾動條添加}
    CW_USEDEFAULT, CW_USEDEFAULT, 544, 375, HWND_DESKTOP, 0, hInstance, 0);

  ShowWindow(mHwnd, SW_SHOW);
  UpdateWindow(mHwnd);
  while GetMessage(message, 0, 0, 0) do
  begin
    TranslateMessage(message);
    DispatchMessage(message);
  end;
end.

《windows程序設計》滾動條Ⅱ（08）