程序4-3 Sysmets2

program Sysmets2;

uses
  Windows, Messages, Math,
  sysmets in '..\sysmets.pas';

function WndProc(hwindow: HWND; message, wParam, lParam: LongInt): LRESULT; stdcall;
const
{$J+}
  cxChar: Integer = 0;
  cxCaps: Integer = 0;
  cyChar: Integer = 0;
  cyClient: Integer = 0;
  iVscrollPos: Integer = 0;
{$J-}
var
  tm: TTextMetric;
  hdc1,hWndDc: HDC;
  ps: TPaintStruct;
  i, y: integer;
  szBuffer: array[0..5] of Char; //应该是0..5  6个字符，实际显示为5个字符，最后一个为\0,不然有错误
  tmp: integer;
  J,L: Integer; // 循环变量, 输出纵坐标, 转换列表(这里只有一个)
  Buffer: array [0..5] of Char; // 转换输出缓冲区
begin
  Result:= 0;
  case message of
  WM_CREATE:
  begin
    hdc1:= GetDC(hwindow);
    GetTextMetrics(hdc1, tm);
    cxChar:= tm.tmAveCharWidth;
    cyChar:= tm.tmHeight + tm.tmExternalLeading;
    if tm.tmPitchAndFamily and $1 = 0 then
      cxCaps:= cxChar
    else
      cxCaps:= (cxChar * 3) div 2;

    ReleaseDC(hwindow, hdc1);
    SetScrollRange(hwindow, SB_VERT, 0, NUMLINES-1, False);  //设置滚动条的范围
    SetScrollPos(hwindow, SB_VERT, iVscrollPos, True);   //设置滚动条的位置
  end;

  WM_SIZE:  //获取窗口大小
  begin
    cyClient:= HiWord(lParam);
  end;

  WM_VSCROLL:  //响应滚动条，设置相应的位置
  begin
    case LoWord(wParam) of
      SB_LINEUP:    //上滚一行
      begin
        Dec(iVscrollPos);
      end;
      SB_LINEDOWN:   //下滚一行
      begin
        Inc(iVscrollPos);
      end;
      SB_PAGEUP:   //向上翻页
      begin
        //每页行数  cyClient div cyChar
        Dec(iVscrollPos, cyClient div cyChar);
      end;
      SB_PAGEDOWN: //向下翻页
      begin
        Inc(iVscrollPos, cyClient div cyChar);
      end;
      SB_THUMBPOSITION: //拖拽停止
      begin
        iVscrollPos:= HiWord(wParam);
      end;
    end;
    iVscrollPos := Max(0, Min(iVscrollPos, NUMLINES-1)); // 范围限制  好像没什么用
          //设置滚动条位置
    if iVscrollPos <> GetScrollPos(hwindow, SB_VERT) then
    begin
      SetScrollPos(hwindow, SB_VERT, iVscrollPos, True);
      InvalidateRect(hwindow, nil, True);                              //使客户区失效，会产生一个WM_PAINT消息
    end;
  end;

  WM_DESTROY:
  begin
    PostQuitMessage(0);
  end;

  WM_PAINT:
  begin
    hdc1:= BeginPaint(hwindow, ps);
    y:= iVscrollPos*cyChar; //向上有iVscrollPos行数据，但显示不出来。

    for i:= 0 to NUMLINES-1 do
    begin
      //y:= (i-iVscrollPos)*cyChar;
      TextOut(hdc1, 0, cyChar*i-y, SysMetrics[i].szLabel, lstrlen(SysMetrics[i].szLabel));// 显示索引名

      TextOut(hdc1, 22*cxCaps, cyChar*i-y, SysMetrics[i].szDesc, lstrlen(SysMetrics[i].szDesc));// 显示描述
      SetTextAlign(hdc1, TA_RIGHT or TA_TOP);

      tmp:= GetSystemMetrics(SysMetrics[i].Index);
      wvsprintf(szBuffer, '%5d', @tmp);
      TextOut(hdc1, 22*cxCaps+40*cxChar, cyChar*i-y, szBuffer, 5);// 实际数值

      SetTextAlign(hdc1, TA_LEFT or TA_TOP);

    end;

          {
                for J := 0 to NUMLINES-1 do // 绘制各行
                begin
                  Y := cyChar * (J - iVscrollPos);   // 计算本行输出纵坐标
                  TextOut(hdc1, 0, Y, SysMetrics[J].szLabel, lstrlen(SysMetrics[J].szLabel));
                  TextOut(hdc1, 22 * cxCaps, Y, SysMetrics[J].szDesc, lstrlen(SysMetrics[J].szDesc));
                  SetTextAlign(hdc1, TA_RIGHT or TA_TOP); // 此后所给坐标视为右上角之坐标
                  L := GetSystemMetrics(SysMetrics[J].Index);
                  TextOut(hdc1, 22 * cxCaps + 40 * cxChar, Y, Buffer, wvsprintf(Buffer, '%5d', @L));
                  SetTextAlign(hdc1, TA_LEFT or TA_TOP); // 此后所给坐标视为左上角之坐标
                end;
                }
    EndPaint(hwindow, ps);
  end;
  else
  begin
    Result:= DefWindowProc(hwindow, message, wParam, lParam);
  end;
  end;
end;
const
  szAppName = 'Sysmets2';
var
  hwindow: HWND;
  msg1: MSG;
  wndclass1: WNDCLASS;
begin
  wndclass1.style:= CS_VREDRAW or CS_HREDRAW;
  wndclass1.lpfnWndProc:= @WndProc;
  wndclass1.cbClsExtra:= 0;
  wndclass1.cbWndExtra:= 0;
  wndclass1.hInstance:= HInstance;
  wndclass1.hIcon:= LoadIcon(0, IDI_APPLICATION);
  wndclass1.hCursor:= LoadCursor(0, IDC_ARROW);
  wndclass1.hbrBackground:= GetStockObject(WHITE_BRUSH);//GetStockObject(LTGRAY_BRUSH);
  wndclass1.lpszMenuName:= nil;
  wndclass1.lpszClassName:= szAppName;

  if RegisterClass(wndclass1) = 0 then
  begin
    MessageBox(0, 'This program requires windows NT!', szAppName, MB_ICONERROR);
    exit;
  end;

  hwindow:= CreateWindow(szAppName, 'Get System Metrics No.2', WS_OVERLAPPEDWINDOW or WS_VSCROLL,
                         CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,
                         0, 0, HInstance, nil);
  ShowWindow(hwindow, CmdShow);
  UpdateWindow(hwindow);

  while GetMessage(msg1, 0, 0, 0) do
  begin
    TranslateMessage(msg1);
    DispatchMessage(msg1);
  end;
end.