程序5-1 Devcaps1

program Devcaps1;

uses
  Windows,
  Messages,
  DevcapsConst in 'DevcapsConst.pas';

function WndProc(hWindow: HWND; message, wParam, lParam: LongInt): LRESULT; stdcall;
{$J+}
const
  cxChar: Integer = 0;
  cyChar: Integer = 0;
  cxCaps: Integer = 0;
{$J-}
var
  tm: TTextMetricA;
  hdc1: HDC;
  ps: TPaintStruct;
  i, OutList: integer;
  szBuffer: array[0..5] of AnsiChar;
begin
  Result:= 0;
  case message of
    WM_CREATE:
    begin
      hdc1:= GetDC(hWindow);
      GetTextMetricsA(hdc1, tm);
      ReleaseDC(hWindow, hdc1);

      cyChar:= tm.tmHeight+tm.tmExternalLeading;
      cxchar:= tm.tmAveCharWidth;
      if (tm.tmPitchAndFamily and $1) = 0 then
        cxCaps:= tm.tmAveCharWidth
      else
        cxCaps:= (tm.tmAveCharWidth * 3) div 2;
    end;
    WM_DESTROY:
    begin
      PostQuitMessage(0);
    end;
    WM_PAINT:
    begin
      hdc1:= BeginPaint(hWindow, ps);

      for i := 0 to NUMLINES - 1 do
      begin
        TextOutA(hdc1, 0, cyChar*i, devcaps[i].szLabel, lstrlenA(devcaps[i].szLabel));
        SetTextAlign(hdc1, TA_RIGHT or TA_TOP);
        TextOutA(hdc1, 40*cxCaps, cyChar*i, devcaps[i].szDesc, lstrlenA(devcaps[i].szDesc));

        OutList:= GetDeviceCaps(hdc1, devcaps[i].iIndex);
        TextOutA(hdc1, 40*cxCaps + 22*cxChar, cyChar*i, szBuffer, wvsprintfA(szBuffer, '%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 = 'DEVCAPS1';
var
  hwnd1: 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(HInstance, IDI_APPLICATION);
  wndclass1.hCursor:= LoadCursor(HInstance, IDC_ARROW);
  wndclass1.hbrBackground:= GetStockObject(WHITE_BRUSH);
  wndclass1.lpszMenuName:= nil;
  wndclass1.lpszClassName:= szAppName;

  if RegisterClass(wndclass1) = 0 then
  begin
    MessageBoxA(0, 'This program requires Windows NT!', szAppName, MB_ICONERROR);
    exit;
  end;

  hwnd1:= CreateWindowA(szAppName, 'Device Capabilities', WS_OVERLAPPEDWINDOW,
    CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, HInstance, nil);

  ShowWindow(hwnd1, CmdShow);
  UpdateWindow(hwnd1);

  while GetMessage(msg1, 0, 0, 0) do
  begin
    TranslateMessage(msg1);
    DispatchMessage(msg1);
  end;
end.