Last updated: 22. 1.1998, 21:33
<* +M2EXTENSIONS *> MODULE DevCaps2; (*------------------------------------------------------------------ DEVCAPS2.C --- Displays Device Capability Information (Version 2) (c) Charles Petzold, 1996 DevCaps2.mod --- Translation to XDS Modula-2 (c) Peter Stadler, 1997 ------------------------------------------------------------------*) IMPORT Windows; IMPORT SYSTEM; IMPORT h2d_devcaps2; IMPORT Str; VAR hwnd : Windows.HWND; msg : Windows.MSG; wc : Windows.WNDCLASSEX; VAR (* static in WndProc *) szDevice : Windows.PSTR; szWindowText : Windows.PSTR; n : INTEGER; cxChar : INTEGER; cyChar : INTEGER; nCurrentDevice : INTEGER; nCurrentInfo : INTEGER; dwNeeded : Windows.DWORD; dwReturned : Windows.DWORD; pinfo5 : Windows.PPRINTER_INFO_5; (* static in DoBasicInfo *) TYPE Info = RECORD nIndex : INTEGER; szDesc : ARRAY[0..50] OF CHAR; END; InfoArr= ARRAY[0..19] OF Info; (* static in DoOtherInfo *) TYPE Raster = ARRAY[0..11] OF h2d_devcaps2.BITS_RC; TYPE SzTech = ARRAY[0..6] OF ARRAY[0..50] OF CHAR; (* static in DoBitCodedCaps *) TYPE Curves = ARRAY[0..7] OF h2d_devcaps2.BITS_CC; TYPE Lines = ARRAY[0..6] OF h2d_devcaps2.BITS_LC; TYPE Poly = ARRAY[0..7] OF h2d_devcaps2.BITS_PC; TYPE Text = ARRAY[0..14] OF h2d_devcaps2.BITS_TC; TYPE BITSARRAY = ARRAY[0..14] OF h2d_devcaps2.BITS; BitInfo = RECORD nIndex : INTEGER; szTitle : ARRAY[0..50] OF CHAR; pbits : BITSARRAY; nSize : INTEGER (*Windows.SHORT*); END; BitInfoArr= ARRAY[0..3] OF BitInfo; CONST szAppName = "DevCaps2"; info = InfoArr { {Windows.HORZSIZE, "HORZSIZE Width in millimeters:"}, {Windows.VERTSIZE, "VERTSIZE Height in millimeters:"}, {Windows.HORZRES, "HORZRES Width in pixels:"}, {Windows.VERTRES, "VERTRES Height in raster lines:"}, {Windows.BITSPIXEL, "BITSPIXEL Color bits per pixel:"}, {Windows.PLANES, "PLANES Number of color planes:"}, {Windows.NUMBRUSHES, "NUMBRUSHES Number of device brushes:"}, {Windows.NUMPENS, "NUMPENS Number of device pens:"}, {Windows.NUMMARKERS, "NUMMARKERS Number of device markers:"}, {Windows.NUMFONTS, "NUMFONTS Number of device fonts:"}, {Windows.NUMCOLORS, "NUMCOLORS Number of device colors:"}, {Windows.PDEVICESIZE, "PDEVICESIZE Size of device structure:"}, {Windows.ASPECTX, "ASPECTX Relative width of pixel:"}, {Windows.ASPECTY, "ASPECTY Relative height of pixel:"}, {Windows.ASPECTXY, "ASPECTXY Relative diagonal of pixel:"}, {Windows.LOGPIXELSX, "LOGPIXELSX Horizontal dots per inch:"}, {Windows.LOGPIXELSY, "LOGPIXELSY Vertical dots per inch:"}, {Windows.SIZEPALETTE, "SIZEPALETTE Number of palette entries:"}, {Windows.NUMRESERVED, "NUMRESERVED Reserved palette entries:"}, {Windows.COLORRES, "COLORRES Actual color resolution:"} }; clip = h2d_devcaps2.BITS { Windows.CP_RECTANGLE, "CP_RECTANGLE", "Can Clip To Rectangle:" }; raster = Raster { {Windows.RC_BITBLT, "RC_BITBLT", "Capable of simple BitBlt:"}, {Windows.RC_BANDING, "RC_BANDING", "Requires banding support:"}, {Windows.RC_SCALING, "RC_SCALING", "Requires scaling support:"}, {Windows.RC_BITMAP64, "RC_BITMAP64", "Supports bitmaps >64K:"}, {Windows.RC_GDI20_OUTPUT, "RC_GDI20_OUTPUT","Has 2.0 output calls:"}, {Windows.RC_DI_BITMAP, "RC_DI_BITMAP", "Supports DIB to memory:"}, {Windows.RC_PALETTE, "RC_PALETTE", "Supports a palette:"}, {Windows.RC_DIBTODEV, "RC_DIBTODEV", "Supports bitmap conversion:"}, {Windows.RC_BIGFONT, "RC_BIGFONT", "Supports fonts >64K:"}, {Windows.RC_STRETCHBLT, "RC_STRETCHBLT", "Supports StretchBlt:"}, {Windows.RC_FLOODFILL, "RC_FLOODFILL", "Supports FloodFill:"}, {Windows.RC_STRETCHDIB, "RC_STRETCHDIB", "Supports StretchDIBits:"} }; szTech = SzTech {"DT_PLOTTER (Vector plotter)", "DT_RASDISPLAY (Raster display)", "DT_RASPRINTER (Raster printer)", "DT_RASCAMERA (Raster camera)", "DT_CHARSTREAM (Character-stream, PLP)", "DT_METAFILE (Metafile, VDM)", "DT_DISPFILE (Display-file)" }; curves = Curves { {Windows.CC_CIRCLES, "CC_CIRCLES", "circles:"}, {Windows.CC_PIE, "CC_PIE", "pie wedges:"}, {Windows.CC_CHORD, "CC_CHORD", "chord arcs:"}, {Windows.CC_ELLIPSES, "CC_ELLIPSES", "ellipses:"}, {Windows.CC_WIDE, "CC_WIDE", "wide borders:"}, {Windows.CC_STYLED, "CC_STYLED", "styled borders:"}, {Windows.CC_WIDESTYLED, "CC_WIDESTYLED","wide and styled borders:"}, {Windows.CC_INTERIORS, "CC_INTERIORS", "interiors:"} }; lines = Lines { {Windows.LC_POLYLINE, "LC_POLYLINE", "polyline:"}, {Windows.LC_MARKER, "LC_MARKER", "markers:"}, {Windows.LC_POLYMARKER, "LC_POLYMARKER","polymarkers"}, {Windows.LC_WIDE, "LC_WIDE", "wide lines:"}, {Windows.LC_STYLED, "LC_STYLED", "styled lines:"}, {Windows.LC_WIDESTYLED, "LC_WIDESTYLED","wide and styled lines:"}, {Windows.LC_INTERIORS, "LC_INTERIORS", "interiors:"} }; poly = Poly { {Windows.PC_POLYGON, "PC_POLYGON", "alternate fill polygon:"}, {Windows.PC_RECTANGLE, "PC_RECTANGLE", "rectangle:"}, {Windows.PC_WINDPOLYGON,"PC_WINDPOLYGON","winding number fill polygon:"}, {Windows.PC_SCANLINE, "PC_SCANLINE", "scanlines:"}, {Windows.PC_WIDE, "PC_WIDE", "wide borders:"}, {Windows.PC_STYLED, "PC_STYLED", "styled borders:"}, {Windows.PC_WIDESTYLED, "PC_WIDESTYLED", "wide and styled borders:"}, {Windows.PC_INTERIORS, "PC_INTERIORS", "interiors:"} }; text = Text { {Windows.TC_OP_CHARACTER, "TC_OP_CHARACTER", "character output precision:"}, {Windows.TC_OP_STROKE, "TC_OP_STROKE", "stroke output precision:"}, {Windows.TC_CP_STROKE, "TC_CP_STROKE", "stroke clip precision:"}, {Windows.TC_CR_90, "TC_CP_90", "90 degree character rotation:"}, {Windows.TC_CR_ANY, "TC_CR_ANY", "any character rotation:"}, {Windows.TC_SF_X_YINDEP, "TC_SF_X_YINDEP", "scaling independent of X and Y:"}, {Windows.TC_SA_DOUBLE, "TC_SA_DOUBLE", "doubled character for scaling:"}, {Windows.TC_SA_INTEGER, "TC_SA_INTEGER", "integer multiples for scaling:"}, {Windows.TC_SA_CONTIN, "TC_SA_CONTIN", "any multiples for exact scaling:"}, {Windows.TC_EA_DOUBLE, "TC_EA_DOUBLE", "double weight characters:"}, {Windows.TC_IA_ABLE, "TC_IA_ABLE", "italicizing:"}, {Windows.TC_UA_ABLE, "TC_UA_ABLE", "underlining:"}, {Windows.TC_SO_ABLE, "TC_SO_ABLE", "strikeouts:"}, {Windows.TC_RA_ABLE, "TC_RA_ABLE", "raster fonts:"}, {Windows.TC_VA_ABLE, "TC_VA_ABLE", "vector fonts:"} }; bitinfo = BitInfoArr { {Windows.CURVECAPS, "CURVCAPS (Curve Capabilities)", SYSTEM.CAST(BITSARRAY,curves), 14 }, {Windows.LINECAPS, "LINECAPS (Line Capabilities)", SYSTEM.CAST(BITSARRAY,lines), 14 }, {Windows.POLYGONALCAPS, "POLYGONALCAPS (Polygonal Capabilities)", SYSTEM.CAST(BITSARRAY,poly), 14 }, {Windows.TEXTCAPS, "TEXTCAPS (Text Capabilities)", SYSTEM.CAST(BITSARRAY,text), 14 } }; (*++++*****************************************************************) PROCEDURE DoBasicInfo (hdc : Windows.HDC; hdcInfo : Windows.HDC; cxChar : INTEGER; cyChar : INTEGER); (**********************************************************************) VAR szBuffer : ARRAY[0..79] OF CHAR; i : INTEGER; BEGIN FOR i := 0 TO (SIZE (info) DIV SIZE (info[0]))-1 DO Windows.TextOut (hdc, cxChar, (i + 1) * cyChar, szBuffer, Windows.wsprintf (szBuffer, "%-40s%8d", info[i].szDesc, Windows.GetDeviceCaps (hdcInfo, info[i].nIndex))); END; END DoBasicInfo; (*++++*****************************************************************) PROCEDURE DoOtherInfo (hdc : Windows.HDC; hdcInfo : Windows.HDC; cxChar : INTEGER; cyChar : INTEGER); (**********************************************************************) VAR szBuffer : ARRAY[0..79] OF CHAR; i : INTEGER; BEGIN Windows.TextOut (hdc, cxChar, cyChar, szBuffer, Windows.wsprintf (szBuffer, "%-24s%04XH", "DRIVERVERSION:", Windows.GetDeviceCaps (hdcInfo, Windows.DRIVERVERSION))); Windows.TextOut (hdc, cxChar, 2 * cyChar, szBuffer, Windows.wsprintf (szBuffer, "%-24s%-40s", "TECHNOLOGY:", szTech[Windows.GetDeviceCaps (hdcInfo, Windows.TECHNOLOGY)])); Windows.TextOut (hdc, cxChar, 4 * cyChar, szBuffer, Windows.wsprintf (szBuffer, "CLIPCAPS (Clipping capabilities)")); FOR i := 0 TO (SIZE (clip) DIV SIZE (clip.nMask))-1 DO IF( (Windows.GetDeviceCaps (hdcInfo, Windows.CLIPCAPS) - VAL(INTEGER,clip.nMask))=1) THEN Windows.TextOut (hdc, 9 * cxChar, (i + 6) * cyChar, szBuffer, Windows.wsprintf (szBuffer, "%-16s%-28s %3s", clip.szMask, clip.szDesc,"Yes")); ELSE Windows.TextOut (hdc, 9 * cxChar, (i + 6) * cyChar, szBuffer, Windows.wsprintf (szBuffer, "%-16s%-28s %3s", clip.szMask, clip.szDesc,"No")); END; END; Windows.TextOut (hdc, cxChar, 8 * cyChar, szBuffer, Windows.wsprintf (szBuffer, "RASTERCAPS (Raster capabilities)")); FOR i := 0 TO (SIZE (raster) DIV SIZE (raster[0]))-1 DO IF((Windows.GetDeviceCaps (hdcInfo, Windows.RASTERCAPS) - SYSTEM.CAST(INTEGER,raster[i].nMask))=1) THEN Windows.TextOut (hdc, 9 * cxChar, (i + 10) * cyChar, szBuffer, Windows.wsprintf (szBuffer, "%-16s%-28s %3s", raster[i].szMask, raster[i].szDesc,"Yes")) ELSE Windows.TextOut (hdc, 9 * cxChar, (i + 10) * cyChar, szBuffer, Windows.wsprintf (szBuffer, "%-16s%-28s %3s", raster[i].szMask, raster[i].szDesc,"No")); END; END; END DoOtherInfo; (*++++*****************************************************************) PROCEDURE DoBitCodedCaps (hdc : Windows.HDC; hdcInfo : Windows.HDC; cxChar : INTEGER; cyChar : INTEGER; nType : INTEGER); (**********************************************************************) TYPE PBITSARRAY = POINTER TO BITSARRAY; VAR szBuffer : ARRAY[0..79] OF CHAR; pbits : PBITSARRAY; (* pbits : ARRAY[0..14] OF POINTER TO h2d_devcaps2.BITS; *) nDevCaps : INTEGER; i : INTEGER(*16*); BEGIN pbits := SYSTEM.CAST(PBITSARRAY,bitinfo[nType].pbits); nDevCaps := Windows.GetDeviceCaps (hdcInfo, bitinfo[nType].nIndex); Windows.TextOut (hdc, cxChar, cyChar, bitinfo[nType].szTitle, LENGTH(bitinfo[nType].szTitle)); FOR i := 0 TO bitinfo[nType].nSize-1 DO IF(nDevCaps - VAL(INTEGER,pbits^[i].nMask)=1) THEN Windows.TextOut (hdc, cxChar, (i + 3) * cyChar, szBuffer, Windows.wsprintf (szBuffer, "%-16s %s %-32s %3s", pbits^[i].szMask, "Can do", pbits^[i].szDesc, "Yes")); ELSE Windows.TextOut (hdc, cxChar, (i + 3) * cyChar, szBuffer, Windows.wsprintf (szBuffer, "%-16s %s %-32s %3s", pbits^[i].szMask, "Can do", pbits^[i].szDesc, "No")); END; END; END DoBitCodedCaps; (*++++*****************************************************************) PROCEDURE [Windows.CALLBACK] WndProc (hwnd : Windows.HWND; iMsg : Windows.UINT; wParam : Windows.WPARAM; lParam : Windows.LPARAM) : Windows.LRESULT; (**********************************************************************) VAR i : Windows.DWORD; hdc : Windows.HDC; hdcInfo : Windows.HDC; hMenu : Windows.HMENU; ps : Windows.PAINTSTRUCT; tm : Windows.TEXTMETRIC; hPrint : Windows.HANDLE; pStr : Windows.PSTR; BEGIN CASE (iMsg) OF | Windows.WM_CREATE : hdc := Windows.GetDC (hwnd); Windows.SelectObject (hdc, Windows.GetStockObject (Windows.SYSTEM_FIXED_FONT)); Windows.GetTextMetrics (hdc, tm); cxChar := tm.tmAveCharWidth; cyChar := tm.tmHeight + tm.tmExternalLeading; Windows.ReleaseDC (hwnd, hdc); lParam := 0; (* fall through *) | Windows.WM_WININICHANGE : pStr := SYSTEM.CAST(Windows.PSTR,lParam); IF(Str.Compare(pStr^,"devices")#0) AND(lParam#0) THEN RETURN 0; END; hMenu := Windows.GetSubMenu (Windows.GetMenu (hwnd), 0); WHILE (Windows.GetMenuItemCount (hMenu) > 1) DO Windows.DeleteMenu (hMenu, 1, Windows.MF_BYPOSITION); END; (* Get a list of all local and remote printers *) (* *) (* First, find out how large an array we need; this *) (* call will fail, leaving the required size in dwNeeded *) Windows.EnumPrinters (Windows.PRINTER_ENUM_LOCAL, NIL, 5, SYSTEM.CAST(Windows.PBYTE,""), 0, dwNeeded, dwReturned); (* Next, allocate space for PRINTER_INFO_5 array *) IF (pinfo5#NIL) THEN Windows.HeapFree (Windows.GetProcessHeap (), SYSTEM.CAST(Windows.HEAP_SET,0), pinfo5); END; pinfo5 := SYSTEM.CAST(Windows.PPRINTER_INFO_5,Windows.HeapAlloc (Windows.GetProcessHeap (), Windows.HEAP_NO_SERIALIZE, dwNeeded)); (* Last, fill allocated PRINTER_INFO_5 array *) IF (pinfo5=NIL) OR (Windows.EnumPrinters (Windows.PRINTER_ENUM_LOCAL, NIL, 5, SYSTEM.CAST(Windows.PBYTE,pinfo5), dwNeeded, dwNeeded, dwReturned)=TRUE) THEN Windows.MessageBox (hwnd, "Could not enumerate printers!", NIL, Windows.MB_ICONSTOP); Windows.DestroyWindow (hwnd); RETURN 0; END; n := h2d_devcaps2.IDM_SCREEN+1; FOR i := 0 TO dwReturned-1 DO IF(n REM 16#0) THEN Windows.AppendMenu (hMenu, SYSTEM.CAST(Windows.MF_SET,0), n, pinfo5^.pPrinterName); ELSE Windows.AppendMenu (hMenu, Windows.MF_MENUBARBREAK, n,pinfo5^.pPrinterName); END; pinfo5 := SYSTEM.ADDADR(pinfo5,1); INC(n); END; Windows.AppendMenu (hMenu, Windows.MF_SEPARATOR, 0, NIL); Windows.AppendMenu (hMenu, SYSTEM.CAST(Windows.MF_SET,0), h2d_devcaps2.IDM_DEVMODE, SYSTEM.ADR("Properties")); wParam := h2d_devcaps2.IDM_SCREEN; (* fall through *) | Windows.WM_COMMAND : hMenu := Windows.GetMenu (hwnd); IF (wParam < h2d_devcaps2.IDM_DEVMODE) THEN (* IDM_SCREEN - Printers *) Windows.CheckMenuItem (hMenu, nCurrentDevice, Windows.MF_UNCHECKED); nCurrentDevice := wParam; Windows.CheckMenuItem (hMenu, nCurrentDevice, Windows.MF_CHECKED); ELSIF (wParam = h2d_devcaps2.IDM_DEVMODE) THEN (* "Properties" selection *) Windows.GetMenuString (hMenu, nCurrentDevice, szDevice^, SIZE (szDevice^), Windows.MF_BYCOMMAND); IF (Windows.OpenPrinter (szDevice, hPrint, NIL)) THEN Windows.PrinterProperties (hwnd, hPrint); Windows.ClosePrinter (hPrint); END; ELSE (* info menu items *) Windows.CheckMenuItem (hMenu, nCurrentInfo, Windows.MF_UNCHECKED); nCurrentInfo := wParam; Windows.CheckMenuItem (hMenu, nCurrentInfo, Windows.MF_CHECKED); END; Windows.InvalidateRect (hwnd, NIL, TRUE); RETURN 0; | Windows.WM_INITMENUPOPUP : IF (lParam = 0) THEN IF(nCurrentDevice = h2d_devcaps2.IDM_SCREEN) THEN Windows.EnableMenuItem (Windows.GetMenu (hwnd), h2d_devcaps2.IDM_DEVMODE,Windows.MF_GRAYED); ELSE Windows.EnableMenuItem (Windows.GetMenu (hwnd), h2d_devcaps2.IDM_DEVMODE,Windows.MF_ENABLED); END; END; RETURN 0; | Windows.WM_PAINT : Str.Copy(szWindowText^,"Device Capabilities: "); IF (nCurrentDevice = h2d_devcaps2.IDM_SCREEN) THEN Str.Copy(szDevice^, "DISPLAY"); hdcInfo := Windows.CreateIC (szDevice, " ", NIL, NIL); ELSE hMenu := Windows.GetMenu (hwnd); Windows.GetMenuString (hMenu, nCurrentDevice, szDevice^, SIZE (szDevice^), Windows.MF_BYCOMMAND); hdcInfo := Windows.CreateIC (NIL, szDevice^, NIL, NIL); END; Str.Append(szWindowText^, szDevice^); Windows.SetWindowText (hwnd, szWindowText^); hdc := Windows.BeginPaint (hwnd, ps); Windows.SelectObject (hdc, Windows.GetStockObject (Windows.SYSTEM_FIXED_FONT)); IF (hdcInfo#NIL) THEN CASE (nCurrentInfo) OF | h2d_devcaps2.IDM_BASIC : DoBasicInfo (hdc, hdcInfo, cxChar, cyChar); RETURN 0; | h2d_devcaps2.IDM_OTHER : DoOtherInfo (hdc, hdcInfo, cxChar, cyChar); RETURN 0; | h2d_devcaps2.IDM_CURVE : DoBitCodedCaps (hdc, hdcInfo, cxChar, cyChar, nCurrentInfo - h2d_devcaps2.IDM_CURVE); | h2d_devcaps2.IDM_LINE : DoBitCodedCaps (hdc, hdcInfo, cxChar, cyChar, nCurrentInfo - h2d_devcaps2.IDM_CURVE); | h2d_devcaps2.IDM_POLY : DoBitCodedCaps (hdc, hdcInfo, cxChar, cyChar, nCurrentInfo - h2d_devcaps2.IDM_CURVE); | h2d_devcaps2.IDM_TEXT : DoBitCodedCaps (hdc, hdcInfo, cxChar, cyChar, nCurrentInfo - h2d_devcaps2.IDM_CURVE); ELSE Windows.DeleteDC (hdcInfo); END; END; Windows.EndPaint (hwnd, ps); RETURN 0; | Windows.WM_DESTROY : IF (pinfo5#NIL) THEN Windows.HeapFree (Windows.GetProcessHeap (), SYSTEM.CAST(Windows.HEAP_SET,0), pinfo5); END; Windows.PostQuitMessage (0); RETURN 0; ELSE RETURN Windows.DefWindowProc (hwnd, iMsg, wParam, lParam); END; END WndProc; (*++++*****************************************************************) PROCEDURE InitApplication () : BOOLEAN; (**********************************************************************) VAR rc : CARDINAL; BEGIN wc.cbSize := SIZE(wc); wc.style := Windows.CS_HREDRAW + Windows.CS_VREDRAW; wc.lpfnWndProc := WndProc; wc.cbClsExtra := 0; wc.cbWndExtra := 0; wc.hInstance := Windows.MyInstance(); wc.hIcon := Windows.LoadIcon (NIL, Windows.IDI_APPLICATION); wc.hCursor := Windows.LoadCursor (NIL, Windows.IDC_ARROW); wc.hbrBackground := SYSTEM.CAST(Windows.HBRUSH, Windows.GetStockObject (Windows.WHITE_BRUSH)); wc.lpszMenuName := SYSTEM.ADR(szAppName); wc.lpszClassName := SYSTEM.ADR(szAppName); wc.hIconSm := Windows.LoadIcon (NIL, Windows.IDI_APPLICATION); rc := Windows.RegisterClassEx(wc); RETURN rc#0; END InitApplication; (*++++*****************************************************************) PROCEDURE InitMainWindow () : BOOLEAN; (**********************************************************************) BEGIN hwnd := Windows.CreateWindow ( SYSTEM.ADR(szAppName), (* window class name *) NIL, (* window caption *) Windows.WS_OVERLAPPEDWINDOW, (* window style *) Windows.CW_USEDEFAULT, (* initial x position *) Windows.CW_USEDEFAULT, (* initial y position *) Windows.CW_USEDEFAULT, (* initial x size *) Windows.CW_USEDEFAULT, (* initial y size *) NIL, (* parent window handle *) NIL, (* window menu handle *) Windows.MyInstance(), (* program instance handle *) NIL); (* creation parameters *) IF hwnd = NIL THEN RETURN FALSE; END; Windows.ShowWindow (hwnd, Windows.SW_SHOWDEFAULT); Windows.UpdateWindow (hwnd); RETURN TRUE; END InitMainWindow; (*++++*****************************************************************) BEGIN nCurrentDevice := h2d_devcaps2.IDM_SCREEN; nCurrentInfo := h2d_devcaps2.IDM_BASIC; IF InitApplication() AND InitMainWindow() THEN WHILE (Windows.GetMessage(msg,NIL,0,0)) DO Windows.TranslateMessage(msg); Windows.DispatchMessage(msg); END; END; END DevCaps2.