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

Previous  Top  Next

    
 

 

 

Code:

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;

 

 

©Drkb::03214

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