《windows程序设计》滚动条Ⅲ(09)
2021-07-07 22:08
标签:winapi efault style 信息 分享图片 extern 需要 utils bottom
《windows程序设计》滚动条Ⅲ(09) 标签:winapi efault style 信息 分享图片 extern 需要 utils bottom 原文地址:https://www.cnblogs.com/YiShen/p/9746618.html更改搞效的滚动条
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;
si: tagSCROLLINFO;
str: string;
TempPos: Integer;
FirstLine: Integer;
LastLine: Integer;
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);
{设置垂直滚动条范围和面页大小}
si.cbSize := SizeOf(si);
si.fMask := SIF_RANGE or SIF_PAGE;
si.nMin := 0;
si.nMax := 100;
si.nPage := cyClient div cychar;
SetScrollInfo(hwnd, SB_VERT, si, true);
result := 0;
Exit;
end;
WM_PAINT:
begin
uHdc := BeginPaint(hwnd, ps);
{获得垂直滚动条的位置}
si.cbSize := SizeOf(si);
si.fMask := SIF_POS;
GetScrollInfo(hwnd, SB_VERT, si);
TempPos := si.nPos;
{计算需要重绘的区域}
FirstLine := TempPos + ps.rcPaint.Top div cychar;
LastLine := TempPos + ps.rcpaint.Bottom div cychar;
Writeln(format(‘%d,%d‘,[FirstLine,lastline]));
for i := FirstLine to LastLine do
begin
str := ‘Hello world num:‘ + i.ToString;
TextOut(uHdc, 0, (i - TempPos) * cychar , PWideChar(str), Length(str));
end;
EndPaint(hwnd, ps);
end;
WM_VSCROLL:
begin
{获得垂直滚动条的所有信息}
si.cbSize := SizeOf(si);
si.fMask := SIF_ALL;
GetScrollInfo(hwnd, SB_VERT, si);
{保存当前滑块位置,迟些进行比较}
TempPos := si.nPos;
case LOWORD(wParam) of
sb_top:
begin
{滚动条到顶端}
si.nPos := si.nMin;
end;
SB_BOTTOM:
begin
{滚动到底端}
si.nPos := si.nMax;
end;
SB_LINEDOWN:
begin
{向下滚动一行}
Inc(si.nPos);
end;
SB_LINEUP:
begin
{向上滚动一行}
Dec(si.nPos);
end;
SB_PAGEDOWN:
begin
{向下滚动一页}
si.nPos := si.nPos + si.nPage;
end;
SB_PAGEUP:
begin
{向上滚动一页}
si.nPos := si.nPos - si.nPage;
end;
SB_THUMBTRACK:
begin
{用户正在拖动滚动条}
si.nPos := si.nTrackPos;
end;
end;
{设置滚动滑块的新位置}
si.fMask := SIF_POS;
SetScrollInfo(hwnd, SB_VERT, si, True);
{获得滑动条滑块的位置,由于窗口调整,它可能不是同一个值}
GetScrollInfo(hwnd, SB_VERT, si);
if si.npos TempPos then
begin
writeln(IntToStr(TempPos - si.npos));
ScrollWindow(hwnd, 0, cychar * (TempPos - si.npos), nil, nil);
UpdateWindow(hwnd);
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.