program Sysmets3;
uses
windows,
Messages, Math,
sysmets in '..\sysmets.pas';
function WndProc(hwindow: HWND; message: UINT; wParam, lParam: LongInt): LRESULT; stdcall;
{$J+}
const
cxChar: Integer = 0;
cyChar: Integer = 0;
cxCaps: Integer = 0;
cyClient: Integer = 0;
iVscrollPos: Integer = 0;
{$J-}
var
i: Integer;
tmpHdc: HDC;
tm: TTextMetric;
si: TScrollInfo;
ps: TPaintStruct;
hdc1: HDC;
iVscrollOldPos: integer;
szBuff: array[0..5] of AnsiChar;
OutList: Integer;
iBegin, iEnd: integer;
begin
Result:= 0;
case message of
WM_CREATE:
begin
tmpHdc:= GetDC(hwindow);
GetTextMetrics(tmpHdc, tm);
ReleaseDC(hwindow, tmpHdc);
cyChar:= tm.tmHeight + tm.tmExternalLeading;
cxChar:= tm.tmAveCharWidth;
if (tm.tmPitchAndFamily and $1 = 0) then
cxCaps:= cxChar
else
cxCaps:= (cxChar*3) div 2;
end;
WM_DESTROY:
begin
PostQuitMessage(0);
end;
WM_SIZE:
begin
cyClient:= HiWord(lParam);
si.cbSize:= SizeOf(si);
si.fMask:= SIF_RANGE or SIF_PAGE or SIF_POS;//SIF_ALL;
si.nMin:= 0;
si.nMax:= NUMLINES-1;
si.nPage:= cyClient div cyChar;
si.nPos:= 0;
//si.nTrackPos
SetScrollInfo(hwindow, SB_VERT, si, True);
end;
WM_VSCROLL:
begin
si.cbSize:= SizeOf(si);
si.fMask:= SIF_POS;
GetScrollInfo(hwindow, SB_VERT, si);
iVscrollOldPos:= si.nPos;
case LOWORD(wParam) of
SB_LINEUP:
begin
Dec(iVscrollPos);
end;
SB_LINEDOWN:
begin
Inc(iVscrollPos);
end;
SB_PAGEUP:
begin
Dec(iVscrollPos, cyClient div cyChar);
end;
SB_PAGEDOWN:
begin
Inc(iVscrollPos, cyClient div cyChar);
end;
SB_THUMBTRACK:
begin
iVscrollPos:= HiWord(wParam);
end;
end;
si.cbSize:= SizeOf(si);
si.fMask:= SIF_POS;
si.nPos:= iVscrollPos;
SetScrollInfo(hwindow, SB_VERT, si, True);
GetScrollInfo(hwindow, SB_VERT, si);
if (iVscrollOldPos <> si.nPos) then
begin //重绘窗口
//此句通知系统本窗口需要垂直滚动cyChar*(iVscrollOldPos-si.nPos)距离
//为此该窗口可能会产生无效区域，所以要在WM_PAINT消息中重点处理无效区域
//比如滚动条向下滚动时，即会出现整个窗口内容向上滚动，因此向上部分由于
//客户区的限制被自然裁剪掉了，
//可是窗口下部分会出现问题，此时这个部分（区域）称为无效区域，要在重绘消息中处理。
ScrollWindow(hwindow, 0, cyChar*(iVscrollOldPos-si.nPos), nil, nil);
UpdateWindow(hwindow); //为了保证拖动滚动条时内容区同时滚动。
end;
end;
WM_PAINT:
begin
hdc1:= BeginPaint(hwindow, ps);
si.cbSize:= SizeOf(si);
si.fMask:= SIF_POS;
GetScrollInfo(hwindow, SB_VERT, si);
iVscrollPos:= si.nPos;
//仅绘制无效区域
//(ps.rcPaint.Top div cyChar) 当前从顶端到无效区域的行数
//si.nPos 当前顶端显示的是Sysmetrics[si.nPos],即第一行在-cyChar*(si.nPos-1)位置处
//无效区域的第一行在Sysmetrics[]中的索引为
// (si.nPos-1)+(ps.rcPaint.Top div cyChar)
//为了确保最小数值在滚动条范围内
iBegin:= Max(0, iVscrollPos+(ps.rcPaint.Top div cyChar));
iEnd:= Min(NUMLINES-1, iVscrollPos+(ps.rcPaint.Bottom div cyChar));
for i := iBegin to iEnd do
begin
//i-iVscrollPos 表明原本应该显示在第i行的文字，由于滚动，导致向上显示在地i- iVscrollPos行位置上
//当滚动条在顶端时，第一行是0，因此第i行就显示在第i行的位置了。
TextOutA(hdc1, 0, cyChar*(i-iVscrollPos), Sysmetrics[i].szLabel, lstrlenA(Sysmetrics[i].szLabel));
TextOutA(hdc1, 22*cxCaps, cyChar*(i-iVscrollPos), Sysmetrics[i].szDesc, lstrlenA(Sysmetrics[i].szDesc));
SetTextAlign(hdc1, TA_RIGHT or TA_TOP);
OutList:= GetSystemMetrics(Sysmetrics[i].Index);
ZeroMemory(@szBuff[0], 6);
TextOutA(hdc1, 22*cxCaps + 44*cxChar, cyChar*(i-iVscrollPos),
szBuff, wvsprintfA(@szBuff[0],'%5d', @OutList));
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 = 'Sysmets3';
var
hwindow: HWND;
wndclass1: TWndClass;
msg1: TMsg;
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);
wndclass1.lpszMenuName:= nil;
wndclass1.lpszClassName:= szAppName;
if (RegisterClass(wndclass1) = 0) then
begin
MessageBox(0, '本程序需要运行在 windows NT !', szAppName, MB_ICONERROR);
Exit;
end;
hwindow:= CreateWindow(szAppName, 'SysMets No.3', 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.
{
BOOL ScrollWindow(
HWND hWnd,
int XAmount,
int YAmount,
const RECT *lpRect,
const RECT *lpClipRect
);
参数 类型及说明
hWnd Long，待滚动窗口的句柄
XAmount Long，水平滚动的距离。正值向右滚动，负值向左滚动
YAmount Long，垂直滚动的距离。正值向下滚动，负值向上滚动
lpRect RECT，用客户区坐标表示的一个矩形，它定义了客户区要滚动的一个部分。如设为NULL，则滚动整个客户区。在NULL的情况下，子窗口和控件的位置也会随同任何无效区域移动。否则，子窗口和无效区域不会一起移动。因此，在滚动之前，如指定了lpRect，一个明智的做法是先调用UpdateWindow函数
lpClipRect RECT，指定剪切区域。只有这个矩形的区域才可能滚动。该矩形优先于lpRect。可设为NULL
参数：
hWnd：客户区域将被滚动的窗体句柄。
XAmount：指定水平滚动以设备为单位的数量。如果窗体被滚动模式为CS_OWNDC或CS_CLASSDC，此参数则使用逻辑单位而不使用设备单位。当向左滚动窗体内容时，参数值必须为负。
YAmount：指定垂直滚动设备单位数量。如果窗体被滚动模式为CS_OWNDC或CS_CLASSDC，此参数则使用逻辑单位而不使用设备单位。当向上滚动窗体内容时，参数值必须为负。
lpRect：指向所指定将被滚动的客户区域部分的RECT结构。若此参数为NULL，则整个客户区域均被滚动。
lpClipRect：指向包含类似于剪辑滚动条RECT结构。只有剪辑矩形条内部的位受影响。由外向内的滚动矩形内部被着色，而由矩形内向外的滚动将不被着色。
}
