program WhatSize;
//程序5-6 WhatSizeze
uses
Windows,
Messages;
procedure Show(hWindow: HWND; hWndc: HDC; xText, yText, iMapMode: integer;
szMapMode: PChar);
var
szBuffer: array[0..59] of char;
List: array[0..4] of LongWord;
rc: TRect;
begin
SaveDC(hWndc);
SetMapMode(hWndc, iMapMode);
GetClientRect(hWindow, rc);
DPtoLP(hWndc, rc, 2);
RestoreDC(hWndc, -1);
List[0]:= LongWord(szMapMode);
List[1]:= rc.Left;
List[2]:= rc.Right;
List[3]:= rc.Top;
List[4]:= rc.Bottom;
TextOut(hWndc, xText, yText, szBuffer, wvsprintf(szBuffer, '%-20s%7d%7d%7d%7d', @List));
end;
function WndProc(hWindow: HWND; Msg, wParam, lParam: LongInt): LRESULT; stdcall;
const
{$J+}
szHeading = 'Mapping Mode Left Right Top Bottom';
szUndLine = '------------ ---- ----- --- ------';
cxChar: integer = 0;
cyChar: integer = 0;
{$J-}
var
hWndc: HDC;
ps: TPaintStruct;
tm: TTextMetric;
begin
Result:= 0;
case Msg of
WM_CREATE:
begin
hWndc:= GetDC(hWindow);
SelectObject(hWndc, GetStockObject(SYSTEM_FIXED_FONT));
GetTextMetrics(hWndc, tm);
cxChar:= tm.tmAveCharWidth;
cyChar:= tm.tmHeight + tm.tmExternalLeading;
ReleaseDC(hWindow, hWndc);
end;
WM_DESTROY:
begin
PostQuitMessage(0);
end;
WM_SIZE:
begin
end;
WM_PAINT:
begin
hWndc:= BeginPaint(hWindow, ps);
SelectObject(hWndc, GetStockObject(SYSTEM_FIXED_FONT));
SetMapMode(hWndc, MM_ANISOTROPIC);
//设置映射比例
SetWindowExtEx(hWndc, 1, 1, nil);
SetViewportExtEx(hWndc, cxChar, cyChar, nil);
TextOut(hWndc, 1, 1, szHeading, lstrlen(szHeading));
TextOut(hWndc, 1, 2, szUndLine, lstrlen(szUndLine));
Show(hWindow, hWndc, 1, 3, MM_TEXT, 'TEXT(pixels)');
Show(hWindow, hWndc, 1, 4, MM_LOMETRIC, 'LOMETRIC(0.1 mm)');
Show(hWindow, hWndc, 1, 5, MM_HIMETRIC, 'HIMETRIC(0.01 mm)');
Show(hWindow, hWndc, 1, 6, MM_LOENGLISH, 'LOENGLISH(0.01 in)');
Show(hWindow, hWndc, 1, 7, MM_HIENGLISH, 'HIENGLISH(0.001 in)');
Show(hWindow, hWndc, 1, 8, MM_TWIPS, 'TWIPS(1/1440 in)');
EndPaint(hWindow, ps);
end
else
Result:= DefWindowProc(hWindow, Msg, wParam, lParam);
end;
end;
const
szAppName = 'WhatSize';
var
wndclass1: TWndClass;
hWindow: HWND;
Msg: TMsg;
begin
WndClass1.style := CS_HREDRAW or CS_VREDRAW;
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, 'Program requires Windows NT!', szAppName, MB_ICONERROR);
Exit;
end;
// 建立窗体
hWindow := CreateWindow(szAppName, 'What size is the window',
WS_OVERLAPPEDWINDOW,
CW_USEDEFAULT, CW_USEDEFAULT,
CW_USEDEFAULT, CW_USEDEFAULT,
0, 0, hInstance, nil);
// 显示窗体
ShowWindow(hWindow, CmdShow);
UpdateWindow(hWindow);
// 消息循环
while GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.
