home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kompon / d2345 / MSYSINFO.ZIP / Source / MSI_Display.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-06-05  |  22.2 KB  |  539 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       MiTeC System Information Component              }
  5. {               Display Detection Part                  }
  6. {           version 5.5 for Delphi 3,4,5                }
  7. {                                                       }
  8. {       Copyright ⌐ 1997,2001 Michal Mutl               }
  9. {                                                       }
  10. {*******************************************************}
  11.  
  12. {$INCLUDE MITEC_DEF.INC}
  13.  
  14. unit MSI_Display;
  15.  
  16. interface
  17.  
  18. uses
  19.   SysUtils, Windows, Classes;
  20.  
  21. type
  22.   TDisplayInfo = record
  23.     DAC,
  24.     Chipset: string;
  25.     Memory: integer;
  26.   end;
  27.  
  28.   TCurveCap = (ccCircles,ccPieWedges,ccChords,ccEllipses,ccWideBorders,ccStyledBorders,
  29.                ccWideStyledBorders,ccInteriors,ccRoundedRects);
  30.   TLineCap = (lcPolylines,lcMarkers,lcMultipleMarkers,lcWideLines,lcStyledLines,
  31.                lcWideStyledLines,lcInteriors);
  32.   TPolygonCap = (pcAltFillPolygons,pcRectangles,pcWindingFillPolygons,pcSingleScanlines,
  33.                  pcWideBorders,pcStyledBorders,pcWideStyledBorders,pcInteriors);
  34.   TRasterCap = (rcRequiresBanding,rcTranserBitmaps,rcBitmaps64K,rcSetGetDIBits,
  35.                 rcSetDIBitsToDevice,rcFloodfills,rcWindows2xFeatures,rcPaletteBased,
  36.                 rcScaling,rcStretchBlt,rcStretchDIBits);
  37.   TTextCap = (tcCharOutPrec,tcStrokeOutPrec,tcStrokeClipPrec,tcCharRotation90,
  38.               tcCharRotationAny,tcScaleIndependent,tcDoubledCharScaling,tcIntMultiScaling,
  39.               tcAnyMultiExactScaling,tcDoubleWeightChars,tcItalics,tcUnderlines,
  40.               tcStrikeouts,tcRasterFonts,tcVectorFonts,tcNoScrollUsingBlts);
  41.  
  42.   TCurveCaps = set of TCurveCap;
  43.   TLineCaps = set of TLineCap;
  44.   TPolygonCaps = set of TPolygonCap;
  45.   TRasterCaps = set of TRasterCap;
  46.   TTextCaps = set of TTextCap;
  47.  
  48.   TDisplay = class(TPersistent)
  49.   private
  50.     FVertRes: integer;
  51.     FColorDepth: integer;
  52.     FHorzRes: integer;
  53.     FBIOSDate: string;
  54.     FBIOSVersion: string;
  55.     FPixelDiagonal: integer;
  56.     FPixelHeight: integer;
  57.     FVertSize: integer;
  58.     FPixelWidth: integer;
  59.     FHorzSize: integer;
  60.     FTechnology: string;
  61.     FCurveCaps: TCurveCaps;
  62.     FLineCaps: TLineCaps;
  63.     FPolygonCaps: TPolygonCaps;
  64.     FRasterCaps: TRasterCaps;
  65.     FTextCaps: TTextCaps;
  66.     FMemory: integer;
  67.     FChipset: string;
  68.     FAdapter: string;
  69.     FDAC: string;
  70.     FModes: TStrings;
  71.     FFontSize: DWORD;
  72.   private
  73.   public
  74.     constructor Create;
  75.     destructor Destroy; override;
  76.     procedure GetInfo;
  77.     procedure Report_CurveCaps(ACaps :TStringList);
  78.     procedure Report_LineCaps(ACaps :TStringList);
  79.     procedure Report_PolygonCaps(ACaps :TStringList);
  80.     procedure Report_RasterCaps(ACaps :TStringList);
  81.     procedure Report_TextCaps(ACaps :TStringList);
  82.     procedure Report(var sl :TStringList);
  83.   published
  84.     property Adapter :string read FAdapter write FAdapter stored false;
  85.     property DAC :string read FDAC write FDAC stored false;
  86.     property Chipset :string read FChipset write FChipset stored false;
  87.     property Memory :Integer read FMemory write FMemory stored false;
  88.     property HorzRes :integer read FHorzRes write FHorzRes stored false;
  89.     property VertRes :integer read FVertRes write FVertRes stored false;
  90.     property ColorDepth :integer read FColorDepth write FColorDepth stored false;
  91.     // BIOS info is available only under NT
  92.     property BIOSVersion :string read FBIOSVersion write FBIOSVersion stored false;
  93.     property BIOSDate :string read FBIOSDate write FBIOSDate stored false;
  94.  
  95.     property Technology :string read FTechnology write FTechnology stored false;
  96.     property PixelWidth :integer read FPixelWidth write FPixelWidth stored false;
  97.     property PixelHeight :integer read FPixelHeight write FPixelHeight stored false;
  98.     property PixelDiagonal :integer read FPixelDiagonal write FPixelDiagonal stored false;
  99.     property RasterCaps :TRasterCaps read FRasterCaps write FRasterCaps stored false;
  100.     property CurveCaps :TCurveCaps read FCurveCaps write FCurveCaps stored false;
  101.     property LineCaps :TLineCaps read FLineCaps write FLineCaps stored false;
  102.     property PolygonCaps :TPolygonCaps read FPolygonCaps write FPolygonCaps stored false;
  103.     property TextCaps :TTextCaps read FTextCaps write FTextCaps stored false;
  104.     property Modes :TStrings read FModes write FModes stored False;
  105.     property FontResolution: DWORD read FFontSize Write FFontSize stored False;
  106.   end;
  107.  
  108. implementation
  109.  
  110. uses Registry, MiTeC_Routines, MSI_Devices;
  111.  
  112. { TDisplay }
  113.  
  114. procedure GetWin9xDisplayInfo(var InfoRecord: TDisplayInfo);
  115. const
  116.   rk = {HKEY_LOCAL_MACHINE\}'System\CurrentControlSet\Services\Class\Display\0000\INFO';
  117.   rvDAC = 'DacType';
  118.   rvChip = 'ChipType';
  119.   rvMem = 'VideoMemory';
  120. begin
  121.   try
  122.  
  123.   with TRegistry.Create do begin
  124.     RootKey:=HKEY_LOCAL_MACHINE;
  125.     if OpenKey(rk,false) then begin
  126.       if ValueExists(rvDAC) then
  127.         InfoRecord.DAC:=ReadString(rvDAC);
  128.       if ValueExists(rvChip) then
  129.         InfoRecord.Chipset:=ReadString(rvChip);
  130.       if ValueExists(rvMem) then
  131.         InfoRecord.Memory:=ReadInteger(rvMem);
  132.       CloseKey;
  133.     end;
  134.     Free;
  135.   end;
  136.  
  137.   except
  138.     on e:Exception do begin
  139.       MessageBox(0,PChar(e.message),'TDisplay.GetWin9xDisplayInfo',MB_OK or MB_ICONERROR);
  140.     end;
  141.   end;
  142. end;
  143.  
  144. procedure GetWinNTDisplayInfo(AServiceName: string; var InfoRecord: TDisplayInfo);
  145. var
  146.   IntData,StrData :PChar;
  147. const
  148.   rk = {HKEY_LOCAL_MACHINE\}'SYSTEM\CurrentControlSet\Services\%s\Device0';
  149.   rvDAC = 'HardwareInformation.DacType';
  150.   rvChip = 'HardwareInformation.ChipType';
  151.   rvMem = 'HardwareInformation.MemorySize';
  152. begin
  153.   try
  154.  
  155.   with TRegistry.Create do begin
  156.     RootKey:=HKEY_LOCAL_MACHINE;
  157.     if OpenKey(Format(rk,[AServiceName]),false) then begin
  158.       StrData:=StrAlloc(255);
  159.       if ValueExists(rvDAC) then
  160.         try
  161.           ReadBinaryData(rvDAC,StrData^,255);
  162.           InfoRecord.DAC:=GetStrFromBuf(PChar(StrData));
  163.         except
  164.         end;
  165.       if ValueExists(rvChip) then
  166.         try
  167.           ReadBinaryData(rvChip,StrData^,255);
  168.           InfoRecord.Chipset:=GetStrFromBuf(PChar(StrData));
  169.         except
  170.         end;
  171.       if ValueExists(rvMem) then
  172.         try
  173.           {IntData:=StrAlloc(255);
  174.           ReadBinaryData(rvMem,IntData,4);
  175.           InfoRecord.Memory:=integer(IntData);
  176.           StrDispose(IntData);}
  177.           ReadBinaryData(rvMem,InfoRecord.Memory,4);
  178.         except
  179.         end;
  180.       StrDispose(StrData);
  181.       CloseKey;
  182.     end;
  183.     Free;
  184.   end;
  185.  
  186.   except
  187.     on e:Exception do begin
  188.       MessageBox(0,PChar(e.message),'TDisplay.GetWinNTDisplayInfo',MB_OK or MB_ICONERROR);
  189.     end;
  190.   end;
  191. end;
  192.  
  193. procedure GetVideoBIOSInfo(var Version, Date: string);
  194. var
  195.   StrData :PChar;
  196. const
  197.   rk = {HKEY_LOCAL_MACHINE\}'HARDWARE\DESCRIPTION\System';
  198.   rvVideoBiosDate = 'VideoBiosDate';
  199.   rvVideoBiosVersion = 'VideoBiosVersion';
  200. begin
  201.   try
  202.  
  203.   with TRegistry.Create do begin
  204.     RootKey:=HKEY_LOCAL_MACHINE;
  205.     if OpenKey(rk,false) then begin
  206.       if ValueExists(rvVideoBIOSVersion) then begin
  207.         try
  208.           StrData:=StrAlloc(255);
  209.           ReadBinaryData(rvVideoBIOSVersion,StrData^,151);
  210.           Version:=StrPas(PChar(StrData));
  211.           StrDispose(StrData);
  212.         except
  213.         end;
  214.       end;
  215.       if ValueExists(rvVideoBIOSDate) then
  216.         Date:=ReadString(rvVideoBIOSDate);
  217.       CloseKey;
  218.     end;
  219.     Free;
  220.   end;
  221.  
  222.   except
  223.     on e:Exception do begin
  224.       MessageBox(0,PChar(e.message),'TDisplay.GetVideoBIOSInfo',MB_OK or MB_ICONERROR);
  225.     end;
  226.   end;
  227. end;
  228.  
  229. procedure TDisplay.GetInfo;
  230. var
  231.   i :integer;
  232.   DevMode : TDevMode;
  233.   Device: TDevice;
  234.   InfoRec: TDisplayInfo;
  235. begin
  236.   try
  237.  
  238.   with TDevices.Create do begin
  239.     GetInfo;
  240.     for i:=0 to DeviceCount-1 do
  241.       if Devices[i].DeviceClass=dcDisplay then begin
  242.         Device:=Devices[i];
  243.         Break;
  244.       end;
  245.     Free;
  246.   end;
  247.  
  248.   if Device.FriendlyName='' then
  249.     FAdapter:=Device.Description
  250.   else
  251.     FAdapter:=Device.FriendlyName;
  252.  
  253.   if IsNT then
  254.     GetWinNTDisplayInfo(Device.Service,InfoRec)
  255.   else
  256.     GetWin9xDisplayInfo(InfoRec);
  257.  
  258.   FDAC:=InfoRec.DAC;
  259.   FChipset:=InfoRec.Chipset;
  260.   FMemory:=InfoRec.Memory;
  261.  
  262.   GetVideoBIOSInfo(FBIOSVersion,FBIOSDate);
  263.  
  264.   FFontSize:=GetDeviceCaps(GetDC(0),LOGPIXELSY);
  265.   FHorzRes:=GetDeviceCaps(GetDC(0),windows.HORZRES);
  266.   FVertRes:=GetDeviceCaps(GetDC(0),windows.VERTRES);
  267.   FColorDepth:=GetDeviceCaps(GetDC(0),BITSPIXEL);
  268.   case GetDeviceCaps(GetDC(0),windows.TECHNOLOGY) of
  269.     DT_PLOTTER:    FTechnology:='Vector Plotter';
  270.     DT_RASDISPLAY: FTechnology:='Raster Display';
  271.     DT_RASPRINTER: FTechnology:='Raster Printer';
  272.     DT_RASCAMERA:  FTechnology:='Raster Camera';
  273.     DT_CHARSTREAM: FTechnology:='Character Stream';
  274.     DT_METAFILE:   FTechnology:='Metafile';
  275.     DT_DISPFILE:   FTechnology:='Display File';
  276.   end;
  277.   FHorzSize:=GetDeviceCaps(GetDC(0),HORZSIZE);
  278.   FVertSize:=GetDeviceCaps(GetDC(0),VERTSIZE);
  279.   FPixelWidth:=GetDeviceCaps(GetDC(0),ASPECTX);
  280.   FPixelHeight:=GetDeviceCaps(GetDC(0),ASPECTY);
  281.   FPixelDiagonal:=GetDeviceCaps(GetDC(0),ASPECTXY);
  282.   FCurveCaps:=[];
  283.   if GetDeviceCaps(GetDC(0),windows.CURVECAPS)<>CC_NONE then begin
  284.     if (GetDeviceCaps(GetDC(0),windows.CURVECAPS) and CC_CIRCLES)=CC_CIRCLES then
  285.       FCurveCaps:=FCurveCaps+[ccCircles];
  286.     if (GetDeviceCaps(GetDC(0),windows.CURVECAPS) and CC_PIE)=CC_PIE then
  287.       FCurveCaps:=FCurveCaps+[ccPieWedges];
  288.     if (GetDeviceCaps(GetDC(0),windows.CURVECAPS) and CC_CHORD)=CC_CHORD then
  289.       FCurveCaps:=FCurveCaps+[ccChords];
  290.     if (GetDeviceCaps(GetDC(0),windows.CURVECAPS) and CC_ELLIPSES)=CC_ELLIPSES then
  291.       FCurveCaps:=FCurveCaps+[ccEllipses];
  292.     if (GetDeviceCaps(GetDC(0),windows.CURVECAPS) and CC_WIDE)=CC_WIDE then
  293.       FCurveCaps:=FCurveCaps+[ccWideBorders];
  294.     if (GetDeviceCaps(GetDC(0),windows.CURVECAPS) and CC_STYLED)=CC_STYLED then
  295.       FCurveCaps:=FCurveCaps+[ccStyledBorders];
  296.     if (GetDeviceCaps(GetDC(0),windows.CURVECAPS) and CC_WIDESTYLED)=CC_WIDESTYLED then
  297.       FCurveCaps:=FCurveCaps+[ccWideStyledBorders];
  298.     if (GetDeviceCaps(GetDC(0),windows.CURVECAPS) and CC_INTERIORS)=CC_INTERIORS then
  299.       FCurveCaps:=FCurveCaps+[ccInteriors];
  300.     if (GetDeviceCaps(GetDC(0),windows.CURVECAPS) and CC_ROUNDRECT)=CC_ROUNDRECT then
  301.       FCurveCaps:=FCurveCaps+[ccRoundedRects];
  302.   end;
  303.   FLineCaps:=[];
  304.   if GetDeviceCaps(GetDC(0),windows.LINECAPS)<>LC_NONE then begin
  305.     if (GetDeviceCaps(GetDC(0),windows.LINECAPS) and LC_POLYLINE)=LC_POLYLINE then
  306.       FLineCaps:=FLineCaps+[lcPolylines];
  307.     if (GetDeviceCaps(GetDC(0),windows.LINECAPS) and LC_MARKER)=LC_MARKER then
  308.       FLineCaps:=FLineCaps+[lcMarkers];
  309.     if (GetDeviceCaps(GetDC(0),windows.LINECAPS) and LC_POLYMARKER)=LC_POLYMARKER then
  310.       FLineCaps:=FLineCaps+[lcMultipleMarkers];
  311.     if (GetDeviceCaps(GetDC(0),windows.LINECAPS) and LC_WIDE)=LC_WIDE then
  312.       FLineCaps:=FLineCaps+[lcWideLines];
  313.     if (GetDeviceCaps(GetDC(0),windows.LINECAPS) and LC_STYLED)=LC_STYLED then
  314.       FLineCaps:=FLineCaps+[lcStyledLines];
  315.     if (GetDeviceCaps(GetDC(0),windows.LINECAPS) and LC_WIDESTYLED)=LC_WIDESTYLED then
  316.       FLineCaps:=FLineCaps+[lcWideStyledLines];
  317.     if (GetDeviceCaps(GetDC(0),windows.LINECAPS) and LC_INTERIORS)=LC_INTERIORS then
  318.       FLineCaps:=FLineCaps+[lcInteriors];
  319.   end;
  320.   FPolygonCaps:=[];
  321.   if GetDeviceCaps(GetDC(0),POLYGONALCAPS)<>PC_NONE then begin
  322.     if (GetDeviceCaps(GetDC(0),POLYGONALCAPS) and PC_POLYGON)=PC_POLYGON then
  323.       FPolygonCaps:=FPolygonCaps+[pcAltFillPolygons];
  324.     if (GetDeviceCaps(GetDC(0),POLYGONALCAPS) and PC_RECTANGLE)=PC_RECTANGLE then
  325.       FPolygonCaps:=FPolygonCaps+[pcRectangles];
  326.     if (GetDeviceCaps(GetDC(0),POLYGONALCAPS) and PC_WINDPOLYGON)=PC_WINDPOLYGON then
  327.       FPolygonCaps:=FPolygonCaps+[pcWindingFillPolygons];
  328.     if (GetDeviceCaps(GetDC(0),POLYGONALCAPS) and PC_SCANLINE)=PC_SCANLINE then
  329.       FPolygonCaps:=FPolygonCaps+[pcSingleScanlines];
  330.     if (GetDeviceCaps(GetDC(0),POLYGONALCAPS) and PC_WIDE)=PC_WIDE then
  331.       FPolygonCaps:=FPolygonCaps+[pcWideBorders];
  332.     if (GetDeviceCaps(GetDC(0),POLYGONALCAPS) and PC_STYLED)=PC_STYLED then
  333.       FPolygonCaps:=FPolygonCaps+[pcStyledBorders];
  334.     if (GetDeviceCaps(GetDC(0),POLYGONALCAPS) and PC_WIDESTYLED)=PC_WIDESTYLED then
  335.       FPolygonCaps:=FPolygonCaps+[pcWideStyledBorders];
  336.     if (GetDeviceCaps(GetDC(0),POLYGONALCAPS) and PC_INTERIORS)=PC_INTERIORS then
  337.       FPolygonCaps:=FPolygonCaps+[pcInteriors];
  338.   end;
  339.   FRasterCaps:=[];
  340.   if (GetDeviceCaps(GetDC(0),windows.RASTERCAPS) and RC_BANDING)=RC_BANDING then
  341.     FRasterCaps:=FRasterCaps+[rcRequiresBanding];
  342.   if (GetDeviceCaps(GetDC(0),windows.RASTERCAPS) and RC_BITBLT)=RC_BITBLT then
  343.     FRasterCaps:=FRasterCaps+[rcTranserBitmaps];
  344.   if (GetDeviceCaps(GetDC(0),windows.RASTERCAPS) and RC_BITMAP64)=RC_BITMAP64 then
  345.     FRasterCaps:=FRasterCaps+[rcBitmaps64K];
  346.   if (GetDeviceCaps(GetDC(0),windows.RASTERCAPS) and RC_DI_BITMAP)=RC_DI_BITMAP then
  347.     FRasterCaps:=FRasterCaps+[rcSetGetDIBits];
  348.   if (GetDeviceCaps(GetDC(0),windows.RASTERCAPS) and RC_DIBTODEV)=RC_DIBTODEV then
  349.     FRasterCaps:=FRasterCaps+[rcSetDIBitsToDevice];
  350.   if (GetDeviceCaps(GetDC(0),windows.RASTERCAPS) and RC_FLOODFILL)=RC_FLOODFILL then
  351.     FRasterCaps:=FRasterCaps+[rcFloodfills];
  352.   if (GetDeviceCaps(GetDC(0),windows.RASTERCAPS) and RC_GDI20_OUTPUT)=RC_GDI20_OUTPUT then
  353.     FRasterCaps:=FRasterCaps+[rcWindows2xFeatures];
  354.   if (GetDeviceCaps(GetDC(0),windows.RASTERCAPS) and RC_PALETTE)=RC_PALETTE then
  355.     FRasterCaps:=FRasterCaps+[rcPaletteBased];
  356.   if (GetDeviceCaps(GetDC(0),windows.RASTERCAPS) and RC_SCALING)=RC_SCALING then
  357.     FRasterCaps:=FRasterCaps+[rcScaling];
  358.   if (GetDeviceCaps(GetDC(0),windows.RASTERCAPS) and RC_STRETCHBLT)=RC_STRETCHBLT then
  359.     FRasterCaps:=FRasterCaps+[rcStretchBlt];
  360.   if (GetDeviceCaps(GetDC(0),windows.RASTERCAPS) and RC_STRETCHDIB)=RC_STRETCHDIB then
  361.     FRasterCaps:=FRasterCaps+[rcStretchDIBits];
  362.   FTextCaps:=[];
  363.   if (GetDeviceCaps(GetDC(0),windows.TEXTCAPS) and TC_OP_CHARACTER)=TC_OP_CHARACTER then
  364.     FTextCaps:=FTextCaps+[tcCharOutPrec];
  365.   if (GetDeviceCaps(GetDC(0),windows.TEXTCAPS) and TC_OP_STROKE)=TC_OP_STROKE then
  366.     FTextCaps:=FTextCaps+[tcStrokeOutPrec];
  367.   if (GetDeviceCaps(GetDC(0),windows.TEXTCAPS) and TC_CP_STROKE)=TC_CP_STROKE then
  368.     FTextCaps:=FTextCaps+[tcStrokeClipPrec];
  369.   if (GetDeviceCaps(GetDC(0),windows.TEXTCAPS) and TC_CR_90)=TC_CR_90 then
  370.     FTextCaps:=FTextCaps+[tcCharRotation90];
  371.   if (GetDeviceCaps(GetDC(0),windows.TEXTCAPS) and TC_CR_ANY)=TC_CR_ANY then
  372.     FTextCaps:=FTextCaps+[tcCharRotationAny];
  373.   if (GetDeviceCaps(GetDC(0),windows.TEXTCAPS) and TC_SF_X_YINDEP)=TC_SF_X_YINDEP then
  374.     FTextCaps:=FTextCaps+[tcScaleIndependent];
  375.   if (GetDeviceCaps(GetDC(0),windows.TEXTCAPS) and TC_SA_DOUBLE)=TC_SA_DOUBLE then
  376.     FTextCaps:=FTextCaps+[tcDoubledCharScaling];
  377.   if (GetDeviceCaps(GetDC(0),windows.TEXTCAPS) and TC_SA_INTEGER)=TC_SA_INTEGER then
  378.     FTextCaps:=FTextCaps+[tcIntMultiScaling];
  379.   if (GetDeviceCaps(GetDC(0),windows.TEXTCAPS) and TC_SA_CONTIN)=TC_SA_CONTIN then
  380.     FTextCaps:=FTextCaps+[tcAnyMultiExactScaling];
  381.   if (GetDeviceCaps(GetDC(0),windows.TEXTCAPS) and TC_EA_DOUBLE)=TC_EA_DOUBLE then
  382.     FTextCaps:=FTextCaps+[tcDoubleWeightChars];
  383.   if (GetDeviceCaps(GetDC(0),windows.TEXTCAPS) and TC_IA_ABLE)=TC_IA_ABLE then
  384.     FTextCaps:=FTextCaps+[tcItalics];
  385.   if (GetDeviceCaps(GetDC(0),windows.TEXTCAPS) and TC_UA_ABLE)=TC_UA_ABLE then
  386.     FTextCaps:=FTextCaps+[tcUnderlines];
  387.   if (GetDeviceCaps(GetDC(0),windows.TEXTCAPS) and  TC_SO_ABLE)=TC_SO_ABLE then
  388.     FTextCaps:=FTextCaps+[tcStrikeouts];
  389.   if (GetDeviceCaps(GetDC(0),windows.TEXTCAPS) and TC_RA_ABLE)=TC_RA_ABLE then
  390.     FTextCaps:=FTextCaps+[tcRasterFonts];
  391.   if (GetDeviceCaps(GetDC(0),windows.TEXTCAPS) and TC_VA_ABLE)=TC_VA_ABLE then
  392.     FTextCaps:=FTextCaps+[tcVectorFonts];
  393.   if (GetDeviceCaps(GetDC(0),windows.TEXTCAPS) and TC_SCROLLBLT)=TC_SCROLLBLT then
  394.     FTextCaps:=FTextCaps+[tcNoScrollUsingBlts];
  395.  
  396.   FModes.Clear;
  397.   i:=0;
  398.   while EnumDisplaySettings(nil,i,Devmode) do
  399.     with Devmode do begin
  400.       FModes.Add(Format('%d x %d - %d bit',[dmPelsWidth,dmPelsHeight,dmBitsPerPel]));
  401.       Inc(i);
  402.     end;
  403.  
  404.   except
  405.     on e:Exception do begin
  406.       MessageBox(0,PChar(e.message),'TDisplay.GetInfo',MB_OK or MB_ICONERROR);
  407.     end;
  408.   end;
  409. end;
  410.  
  411. procedure TDisplay.Report_CurveCaps;
  412. begin
  413.   with ACaps do begin
  414.     Add('[Curve Capabilities]');
  415.     Add(Format('Circles=%d',[integer(ccCircles in CurveCaps)]));
  416.     Add(Format('Pie Wedges=%d',[integer(ccPieWedges in CurveCaps)]));
  417.     Add(Format('Chords=%d',[integer(ccChords in CurveCaps)]));
  418.     Add(Format('Ellipses=%d',[integer(ccEllipses in CurveCaps)]));
  419.     Add(Format('Wide Borders=%d',[integer(ccWideBorders in CurveCaps)]));
  420.     Add(Format('Styled Borders=%d',[integer(ccStyledBorders in CurveCaps)]));
  421.     Add(Format('Wide and Styled Borders=%d',[integer(ccWideStyledBorders in CurveCaps)]));
  422.     Add(Format('Interiors=%d',[integer(ccInteriors in CurveCaps)]));
  423.     Add(Format('Rounded Rectangles=%d',[integer(ccRoundedRects in CurveCaps)]));
  424.   end;
  425. end;
  426.  
  427. procedure TDisplay.Report_LineCaps;
  428. begin
  429.   with ACaps do begin
  430.     Add('[Line Capabilities]');
  431.     Add(Format('Polylines=%d',[integer(lcPolylines in LineCaps)]));
  432.     Add(Format('Markers=%d',[integer(lcMarkers in LineCaps)]));
  433.     Add(Format('Multiple Markers=%d',[integer(lcMultipleMarkers in LineCaps)]));
  434.     Add(Format('Wide Lines=%d',[integer(lcWideLines in LineCaps)]));
  435.     Add(Format('Styled Lines=%d',[integer(lcStyledLines in LineCaps)]));
  436.     Add(Format('Wide and Styled Lines=%d',[integer(lcWideStyledLines in LineCaps)]));
  437.     Add(Format('Interiors=%d',[integer(lcInteriors in LineCaps)]));
  438.   end;
  439. end;
  440.  
  441. procedure TDisplay.Report_PolygonCaps;
  442. begin
  443.   with ACaps do begin
  444.     Add('[Polygonal Capabilities]');
  445.     Add(Format('Alternate Fill Polygons=%d',[integer(pcAltFillPolygons in PolygonCaps)]));
  446.     Add(Format('Rectangles=%d',[integer(pcRectangles in PolygonCaps)]));
  447.     Add(Format('Winding Fill Polygons=%d',[integer(pcWindingFillPolygons in PolygonCaps)]));
  448.     Add(Format('Single Scanlines=%d',[integer(pcSingleScanlines in PolygonCaps)]));
  449.     Add(Format('Wide Borders=%d',[integer(pcWideBorders in PolygonCaps)]));
  450.     Add(Format('Styled Borders=%d',[integer(pcStyledBorders in PolygonCaps)]));
  451.     Add(Format('Wide and Styled Borders=%d',[integer(pcWideStyledBorders in PolygonCaps)]));
  452.     Add(Format('Interiors=%d',[integer(pcInteriors in PolygonCaps)]));
  453.   end;
  454. end;
  455.  
  456. procedure TDisplay.Report_RasterCaps;
  457. begin
  458.   with ACaps do begin
  459.     Add('[Raster Capabilities]');
  460.     Add(Format('Requires Banding=%d',[integer(rcRequiresBanding in RasterCaps)]));
  461.     Add(Format('Can Transer Bitmaps=%d',[integer(rcTranserBitmaps in RasterCaps)]));
  462.     Add(Format('Supports Bitmaps > 64K=%d',[integer(rcBitmaps64K in RasterCaps)]));
  463.     Add(Format('Supports SetDIBits and GetDIBits=%d',[integer(rcSetGetDIBits in RasterCaps)]));
  464.     Add(Format('Supports SetDIBitsToDevice=%d',[integer(rcSetDIBitsToDevice in RasterCaps)]));
  465.     Add(Format('Can Perform Floodfills=%d',[integer(rcFloodfills in RasterCaps)]));
  466.     Add(Format('Supports Windows 2.0 Features=%d',[integer(rcWindows2xFeatures in RasterCaps)]));
  467.     Add(Format('Palette Based=%d',[integer(rcPaletteBased in RasterCaps)]));
  468.     Add(Format('Scaling=%d',[integer(rcScaling in RasterCaps)]));
  469.     Add(Format('Supports StretchBlt=%d',[integer(rcStretchBlt in RasterCaps)]));
  470.     Add(Format('Supports StretchDIBits=%d',[integer(rcStretchDIBits in RasterCaps)]));
  471.   end;
  472. end;
  473.  
  474. procedure TDisplay.Report_TextCaps;
  475. begin
  476.   with ACaps do begin
  477.     Add('[Text Capabilities]');
  478.     Add(Format('Capable of Character Output Precision=%d',[integer(tcCharOutPrec in TextCaps)]));
  479.     Add(Format('Capable of Stroke Output Precision=%d',[integer(tcStrokeOutPrec in TextCaps)]));
  480.     Add(Format('Capable of Stroke Clip Precision=%d',[integer(tcStrokeClipPrec in TextCaps)]));
  481.     Add(Format('Supports 90 Degree Character Rotation=%d',[integer(tcCharRotation90 in TextCaps)]));
  482.     Add(Format('Supports Character Rotation to Any Angle=%d',[integer(tcCharRotationAny in TextCaps)]));
  483.     Add(Format('X And Y Scale Independent=%d',[integer(tcScaleIndependent in TextCaps)]));
  484.     Add(Format('Supports Doubled Character Scaling=%d',[integer(tcDoubledCharScaling in TextCaps)]));
  485.     Add(Format('Supports Integer Multiples Only When Scaling=%d',[integer(tcIntMultiScaling in TextCaps)]));
  486.     Add(Format('Supports Any Multiples For Exact Character Scaling=%d',[integer(tcAnyMultiExactScaling in TextCaps)]));
  487.     Add(Format('Supports Double Weight Characters=%d',[integer(tcDoubleWeightChars in TextCaps)]));
  488.     Add(Format('Supports Italics=%d',[integer(tcItalics in TextCaps)]));
  489.     Add(Format('Supports Underlines=%d',[integer(tcUnderlines in TextCaps)]));
  490.     Add(Format('Supports Strikeouts=%d',[integer(tcStrikeouts in TextCaps)]));
  491.     Add(Format('Supports Raster Fonts=%d',[integer(tcRasterFonts in TextCaps)]));
  492.     Add(Format('Supports Vector Fonts=%d',[integer(tcVectorFonts in TextCaps)]));
  493.     Add(Format('Cannot Scroll Using Blts=%d',[integer(tcNoScrollUsingBlts in TextCaps)]));
  494.   end;
  495. end;
  496.  
  497. constructor TDisplay.Create;
  498. begin
  499.   inherited;
  500.   FModes:=TStringList.Create;
  501. end;
  502.  
  503. destructor TDisplay.Destroy;
  504. begin
  505.   FModes.Free;
  506.   inherited;
  507. end;
  508.  
  509. procedure TDisplay.Report(var sl: TStringList);
  510. begin
  511.   with sl do begin
  512.     Add('[Display]');
  513.     Add(Format('Adapter=%s',[Adapter]));
  514.     Add(Format('Chipset=%s',[Chipset]));
  515.     Add(Format('DAC=%s',[DAC]));
  516.     Add(Format('Memory=%d',[Memory]));
  517.     Add(Format('BIOSVersion=%s',[BIOSVersion]));
  518.     Add(Format('BIOSDate=%s',[BIOSDate]));
  519.     Add(Format('Technology=%s',[Technology]));
  520.     Add(Format('HorzRes=%d',[HorzRes]));
  521.     Add(Format('VertRes=%d',[VertRes]));
  522.     Add(Format('ColorDepth=%d',[ColorDepth]));
  523.     Add(Format('PixelWidth=%d',[PixelWidth]));
  524.     Add(Format('PixelHeight=%d',[PixelHeight]));
  525.     Add(Format('PixelDiag=%d',[PixelDiagonal]));
  526.     Add(Format('FontRes=%d',[FontResolution]));
  527.     Add('[Video Modes]');
  528.     StringsToRep(Modes,'Count','Mode',sl);
  529.     Report_CurveCaps(sl);
  530.     Report_LineCaps(sl);
  531.     Report_PolygonCaps(sl);
  532.     Report_RasterCaps(sl);
  533.     Report_TextCaps(sl);
  534.   end;
  535. end;
  536.  
  537.  
  538. end.
  539.