was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1541)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (126)
Strings (83)
System (266)
VCL (242)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

46 Visitors Online


 
...alle Druckerschächte ermitteln?
Autor: P. Below
Homepage: http://www.teamb.com
[ Tip ausdrucken ]  

Tip Bewertung (20):  
     


uses
  
WinSpool, Printers;

procedure GetPaperBins(sl: TStrings);
type
  
TBinName      = array [0..23] of Char;
  TBinNameArray = array [1..High(Integer) div SizeOf(TBinName)] of TBinName;
  PBinnameArray = ^TBinNameArray;
  TBinArray     = array [1..High(Integer) div SizeOf(Word)] of Word;
  PBinArray     = ^TBinArray;
var
  
Device, Driver, Port: array [0..255] of Char;
  hDevMode: THandle;
  i, numBinNames, numBins, temp: Integer;
  pBinNames: PBinnameArray;
  pBins: PBinArray;
begin
  
Printer.PrinterIndex := -1;
  Printer.GetPrinter(Device, Driver, Port, hDevmode);
  numBinNames := WinSpool.DeviceCapabilities(Device, Port, DC_BINNAMES, nilnil);
  numBins     := WinSpool.DeviceCapabilities(Device, Port, DC_BINS, nilnil);
  if numBins <> numBinNames then
  begin
    raise 
Exception.Create('DeviceCapabilities reports different number of bins and bin names!');
  end;
  if numBinNames > 0 then
  begin
    
pBins := nil;
    GetMem(pBinNames, numBinNames * SizeOf(TBinname));
    GetMem(pBins, numBins * SizeOf(Word));
    try
      
WinSpool.DeviceCapabilities(Device, Port, DC_BINNAMES, PChar(pBinNames), nil);
      WinSpool.DeviceCapabilities(Device, Port, DC_BINS, PChar(pBins), nil);
      sl.Clear;
      for i := 1 to numBinNames do
      begin
        
temp := pBins^[i];
        sl.addObject(pBinNames^[i], TObject(temp));
      end;
    finally
      
FreeMem(pBinNames);
      if pBins <> nil then
        
FreeMem(pBins);
    end;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  
GetPaperBins(Listbox1.Items);
end;


 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners