//程序5-6 WhatSize

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.