Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Как прочитать список возможностей принтера?

01.01.2007
uses 
  Printers; 
 
//------------------------------------------------------------------------------ 
// Printer Device Debugging Code to TMemo Componenet 
// (c) - 1999 / by A. Weidauer 
// alex.weiauer@huckfinn.de 
//------------------------------------------------------------------------------ 
 
procedure GetDeviceSettings(DevCtrl: TMemo); 
var 
  Sep: string; 
  //----------------------------------------------- 
  procedure MakeInt(S: string; key: Integer); 
  begin 
    S := UpperCase(S); 
    DevCtrl.Lines.Add(UpperCase(Format(' %36S = %d ', 
      [s, GetDeviceCaps(Printer.Handle, Key)]))); 
  end; 
  //----------------------------------------------- 
  function StringToBits(S: string): string; 
  var 
    H: string; 
    i: Integer; 
    //----------------------------------------------- 
    function SubStr(C: Char): string; 
    begin 
      if c = '0' then SubStr := '0000'; 
      if c = '1' then SubStr := '0001'; 
      if c = '2' then SubStr := '0010'; 
      if c = '3' then SubStr := '0011'; 
      if c = '4' then SubStr := '0100'; 
      if c = '5' then SubStr := '0101'; 
      if c = '6' then SubStr := '0110'; 
      if c = '7' then SubStr := '0111'; 
      if c = '8' then SubStr := '1000'; 
      if c = '9' then SubStr := '1001'; 
      if c = 'A' then SubStr := '1010'; 
      if c = 'B' then SubStr := '1011'; 
      if c = 'C' then SubStr := '1100'; 
      if c = 'D' then SubStr := '1101'; 
      if c = 'E' then SubStr := '1110'; 
      if c = 'F' then SubStr := '1111'; 
    end; 
    //----------------------------------------------- 
  begin 
    StringToBits := ''; 
    S := UpperCase(s); 
    H := ''; 
    if Length(S) = 0 then Exit; 
    if Length(S) = 1 then S := '0000' + S; 
    if Length(S) = 2 then S := '000' + S; 
    if Length(S) = 3 then S := '00' + S; 
    if Length(S) = 4 then S := '0' + S; 
    for i := 1 to Length(s) do 
      H := H + ' ' + SubStr(S[i]); 
    StringToBits := H; 
  end; 
  //----------------------------------------------- 
  procedure MakeHex(S: string; key: Cardinal); 
  var 
    h: string; 
  begin 
    S := UpperCase(S); 
    h := Format('%X', [GetDeviceCaps(Printer.Handle, Key)]); 
    if Length(H) = 0 then Exit; 
    if Length(H) = 1 then H := '0000' + H; 
    if Length(H) = 2 then H := '000' + H; 
    if Length(H) = 3 then H := '00' + H; 
    if Length(H) = 4 then H := '0' + H; 
    DevCtrl.Lines.Add(''); 
    DevCtrl.Lines.Add(SEP); 
    DevCtrl.Lines.Add(''); 
    DevCtrl.Lines.Add(Format('%37S = Flags(%S) Key(%S)', 
      [s, h, StringToBits(H)] 
      )); 
    // (( GetDeviceCaps(Printer.Handle,Key), 
  end; 
  //---------------------------------------------------- 
  procedure MakeFlag(S: string; key, subKey: Cardinal); 
  var 
    i: Cardinal; 
  begin 
    S := UpperCase(S); 
    i := GetDeviceCaps(Printer.Handle, Key); 
    if i and SubKey <> 0 then 
      DevCtrl.Lines.Add(Format(' %34S = Flag(%4S) Key(%6D,%S)', 
        [s, 'ON ', SubKey, StringToBits(Format('%x', [SubKey]))])) 
    else 
      DevCtrl.Lines.Add(Format(' %34S = Flag(%4S) Key(%6D,%S)', 
        [s, 'OFF', SubKey, StringToBits(Format('%x', [SubKey]))])) 
  end; 
  //---------------------------------------------------- 
  function TechnoToStr(i: Integer): string; 
  begin 
    TechnoToStr := '#ERROR# is Unknwon'; 
    case i of 
      DT_PLOTTER: TechnoToStr    := 'Vector Plotter'; 
      DT_RASDISPLAY: TechnoToStr := 'Raster Display'; 
      DT_RASPRINTER: TechnoToStr := 'Raster Printer'; 
      DT_RASCAMERA: TechnoToStr  := 'Raster Camera'; 
      DT_CHARSTREAM: TechnoToStr := 'Character Stream'; 
      DT_METAFILE: TechnoToStr   := 'Metafile'; 
      DT_DISPFILE: TechnoToStr   := 'Display file'; 
    end; 
  end; 
 
  //--Main Procedure 
  //---------------------------------------------------------- 
begin 
  DevCtrl.SetFocus; 
  DevCtrl.Visible := False; 
  if Printer.PrinterIndex < 0 then Exit; 
  // Device Organisation 
  try 
 
    if not (GetMapMode(Printer.Handle) = MM_TEXT) then 
      SetMapMode(Printer.Handle, MM_Text); 
    DevCtrl.Clear; 
 
    Sep := '______________________________________________________________________________________________'; 
    DevCtrl.Lines.Add(sep); 
    DevCtrl.Lines.Add(''); 
    DevCtrl.Lines.Add(' PRINTER : ' + Printer.Printers[Printer.PrinterIndex]); 
    DevCtrl.Lines.Add(sep); 
    DevCtrl.Lines.Add(''); 
 
    DevCtrl.Lines.Add(sep); 
    DevCtrl.Lines.Add(''); 
    DevCtrl.Lines.Add(Format('%36S = %D', ['NUMBER Of COPIES', Printer.Copies])); 
    if Printer.Orientation = poLandscape then 
      DevCtrl.Lines.Add(Format('%36S = LANDSCAPE', ['ORIENTATION'])); 
    if Printer.Orientation = poPortrait then 
      DevCtrl.Lines.Add(Format('%36S = PORTRAIT', ['ORIENTATION'])); 
 
 
    DevCtrl.Lines.Add(sep); 
    DevCtrl.Lines.Add(''); 
    MakeInt('DRIVERVERSION', DRIVERVERSION); 
    DevCtrl.Lines.Add(Format(' %36S = %S', ['TECHNOLOGY', 
      UpperCase(TechnoToStr(GetDeviceCaps(Printer.Handle, Technology)))])); 
    DevCtrl.Lines.Add(sep); 
    DevCtrl.Lines.Add(''); 
    MakeInt('WIDTH [mm]', HORZSIZE); 
    MakeInt('HEIGHT [mm]', VERTSIZE); 
    MakeInt('WIDTH [pix]', HORZRES); 
    MakeInt('HEIGHT [pix]', VERTRES); 
    DevCtrl.Lines.Add(sep); 
    DevCtrl.Lines.Add(''); 
    MakeInt('Physical Width [pix]', PHYSICALWIDTH); 
    MakeInt('Physical Height[pix]', PHYSICALHEIGHT); 
    MakeInt('Physical Offset X [pix]', PHYSICALOFFSETX); 
    MakeInt('Physical Offset Y [pix]', PHYSICALOFFSETY); 
    MakeInt('SCALING FACTOR X', SCALINGFACTORX); 
    MakeInt('SCALING FACTOR Y', SCALINGFACTORY); 
    DevCtrl.Lines.Add(sep); 
    DevCtrl.Lines.Add(''); 
    MakeInt('horizontal [DPI]', LOGPIXELSX); 
    MakeInt('vertial [DPI]', LOGPIXELSY); 
    MakeInt('BITS PER PIXEL', BITSPIXEL); 
    MakeInt('COLOR PLANES', PLANES); 
    DevCtrl.Lines.Add(sep); 
    DevCtrl.Lines.Add(''); 
    MakeInt('NUMBER OF BRUSHES', NUMBRUSHES); 
    MakeInt('NUMBER OF PENS', NUMPENS); 
    MakeInt('NUMBER OF FONTS', NUMFONTS); 
    MakeInt('NUMBER OF COLORS', NUMCOLORS); 
    DevCtrl.Lines.Add(sep); 
    DevCtrl.Lines.Add(''); 
    MakeInt('ASPECT Ratio X [DPI]', ASPECTX); 
    MakeInt('ASPECT Ratio Y [DPI]', ASPECTY); 
    MakeInt('ASPECT Ratio XY [DPI]', ASPECTXY); 
    DevCtrl.Lines.Add(sep); 
    DevCtrl.Lines.Add(''); 
    MakeInt('SIZE OF PALETTE', SIZEPALETTE); 
    MakeInt('RESERVED TO SYSTEM PALETTE **', NUMRESERVED); 
    MakeInt('ACTUAL RASTER RESOLUTION **', COLORRES); 
    DevCtrl.Lines.Add(''); 
    DevCtrl.Lines.Add(' **...only true if KEY RASTERCAPS(RC_PALETTE)= ON'); 
    MakeFlag('... KEY RASTERCAPS (RC_PALETTE)', RasterCaps, RC_PALETTE); 
    DevCtrl.Lines.Add(''); 
 
    MakeHex('Clipping Capablities ', ClipCaps); 
    DevCtrl.Lines.Add(sep); 
    DevCtrl.Lines.Add(''); 
    MakeFlag('No Support ', ClipCaps, CP_NONE); 
    MakeFlag('Support Rectangles', ClipCaps, CP_RECTANGLE); 
    MakeFlag('Support PolyRegion 32 Bit', ClipCaps, CP_REGION); 
 
    MakeHex('Raster Printing Flags ', RasterCaps); 
    DevCtrl.Lines.Add(sep); 
    DevCtrl.Lines.Add(''); 
    MakeFlag('Support Bitmap Transfer', RasterCaps, RC_BITBLT); 
    MakeFlag('Support Banding', RasterCaps, RC_BANDING); 
    MakeFlag('Support Scaling', RasterCaps, RC_SCALING); 
    MakeFlag('Support Bitmaps > 64 kByte', RasterCaps, RC_BITMAP64); 
    MakeFlag('Support features of Win 2.0', RasterCaps, RC_GDI20_OUTPUT); 
    MakeFlag('Support Set~/GetDIBITS()', RasterCaps, RC_DI_BITMAP); 
    MakeFlag('Support Palette Devices', RasterCaps, RC_PALETTE); 
    MakeFlag('Support SetDIBitsToDevice()', RasterCaps, RC_DIBTODEV); 
    MakeFlag('Support Floodfill', RasterCaps, RC_FLOODFILL); 
    MakeFlag('Support StretchBlt()', RasterCaps, RC_STRETCHBLT); 
    MakeFlag('Support StretchBID()', RasterCaps, RC_STRETCHDIB); 
    MakeFlag('Support DIBS', RasterCaps, RC_DEVBITS); 
 
    MakeHex('Curve Printion Flages', CurveCaps); 
    DevCtrl.Lines.Add(sep); 
    DevCtrl.Lines.Add(''); 
    MakeFlag('No Curve support', CurveCaps, CC_NONE); 
    MakeFlag('Support Circles', CurveCaps, CC_Circles); 
    MakeFlag('Support Pie', CurveCaps, CC_PIE); 
    MakeFlag('Support Arces', CurveCaps, CC_CHORD); 
    MakeFlag('Support Ellipses', CurveCaps, CC_ELLIPSEs); 
    MakeFlag('Support WIDE FRAMES', CurveCaps, CC_WIDE); 
    MakeFlag('Support STYLED FRAMES', CurveCaps, CC_STYLED); 
    MakeFlag('Support WIDE&STYLED FRAMES', CurveCaps, CC_WIDESTYLED); 
    MakeFlag('Support INTERIORS', CurveCaps, CC_INTERIORS); 
    MakeFlag('Support ROUNDRECT', CurveCaps, CC_ROUNDRECT); 
 
    MakeHex('Line & Polygon Printing Flags', LineCaps); 
    DevCtrl.Lines.Add(sep); 
    DevCtrl.Lines.Add(''); 
    MakeFlag('No Line Support', LineCaps, LC_NONE); 
    MakeFlag('Support Polylines', LineCaps, LC_PolyLine); 
    MakeFlag('Support Marker', LineCaps, LC_Marker); 
    MakeFlag('Support PolyMarker', LineCaps, LC_PolyMarker); 
    MakeFlag('Support Wide Lines', LineCaps, LC_WIDE); 
    MakeFlag('Support STYLED Lines', LineCaps, LC_STYLED); 
    MakeFlag('Support WIDE&STYLED Lines', LineCaps, LC_WIDESTYLED); 
    MakeFlag('Support Lines Interiors', LineCaps, LC_INTERIORS); 
 
    MakeHex('Polygon (Areal) Printing Flags', POLYGONALCAPS); 
    DevCtrl.Lines.Add(sep); 
    DevCtrl.Lines.Add(''); 
    MakeFlag('No Polygon Support', PolygonalCaps, PC_NONE); 
    MakeFlag('Filling Alternate Polygons', PolygonalCaps, PC_POLYGON); 
    MakeFlag('Drawing Rectangles', PolygonalCaps, PC_RECTANGLE); 
    MakeFlag('Filling Winding Polygons', PolygonalCaps, PC_WINDPOLYGON); 
    MakeFlag('Drawing Trapezoid (??Flag)', PolygonalCaps, PC_Trapezoid); 
    MakeFlag('Drawing a ScanLine', PolygonalCaps, PC_SCANLINE); 
    MakeFlag('Drawing Wide Border', PolygonalCaps, PC_WIDE); 
    MakeFlag('Drawing Styled Border', PolygonalCaps, PC_STYLED); 
    MakeFlag('Drawing WIDE&STYLED Border', PolygonalCaps, PC_WIDESTYLED); 
    MakeFlag('Drawing Interiors', PolygonalCaps, PC_INTERIORS); 
 
    MakeHex('Text Printing Flags', TEXTCAPS); 
    DevCtrl.Lines.Add(sep); 
    DevCtrl.Lines.Add(''); 
    MakeFlag('Support Character Output Precision', TextCaps, TC_OP_CHARACTER); 
    MakeFlag('Support Stroke Output Precision', TextCaps, TC_OP_STROKE); 
    MakeFlag('Support Stroke Clip Precision', TextCaps, TC_CP_STROKE); 
    MakeFlag('Support 90° Character Rotation', TextCaps, TC_CR_90); 
    MakeFlag('Support any Character Rotaion', TextCaps, TC_CR_ANY); 
    MakeFlag('Support Character Scaling in X&Y', TextCaps, TC_SF_X_YINDEP); 
    MakeFlag('Support Character Scaling REAL', TextCaps, TC_SA_DOUBLE); 
    MakeFlag('Support Character Scaling RATIONAL', TextCaps, TC_SA_INTEGER); 
    MakeFlag('Support Character Scaling EXACT', TextCaps, TC_SA_CONTIN); 
    MakeFlag('Support Character Weight REAL', TextCaps, TC_EA_DOUBLE); 
    MakeFlag('Support Character Italic', TextCaps, TC_IA_ABLE); 
    MakeFlag('Support Character Underline', TextCaps, TC_UA_ABLE); 
    MakeFlag('Support Character Strikeout', TextCaps, TC_SO_ABLE); 
    MakeFlag('Support Character as RASTER FONT', TextCaps, TC_RA_ABLE); 
    MakeFlag('Support Character as VECTOR FONT', TextCaps, TC_VA_ABLE); 
    MakeFlag('Reserved Flag ???', TextCaps, TC_Reserved); 
    MakeFlag('DEVICE NOT USE a SCROLLBIT BLOCK ?', TextCaps, TC_SCROLLBLT); 
    DevCtrl.Lines.Insert(0, '..THE RESULTS ARE:'); 
  except 
    // MessageDlg('The Current Printer is not valid ! ', 
    // mtError,[mbok],0); 
    Printer.PrinterIndex := -1; 
    DevCtrl.Lines.Add(' ! The Printer is not valid !'); 
  end; 
  DevCtrl.Visible := True; 
  DevCtrl.SetFocus; 
end; 

Взято с сайта https://www.swissdelphicenter.ch/en/tipsindex.php