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.
