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