Dicas - Informações da impressora

Você precisa estar logado para dar um feedback. Clique aqui para efetuar o login
Para efetuar o download você precisa estar logado. Clique aqui para efetuar o login
Confirmar voto
0
 (0)  (0)

Uma dica bem interessante que mostra como mostrar informações de uma impressora.

Informações da impressora

 

Uma dica bem interessante que mostra como mostrar informações de uma impressora, confira as linhas do código abaixo.

 

uses Printers;

 

procedure GetDeviceSettings(DevCtrl: TRichEdit);

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;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

  GetDeviceSettings(richedit1);

end;

 

Veja a foto de uma aplicação utilizando a função acima:

 

 
Você precisa estar logado para dar um feedback. Clique aqui para efetuar o login
Ficou com alguma dúvida?