Announcement

**Andreas Kosch** · 13.11.1999, 14:57

Hallo,

im Ordner Win16-API habe ich bereits einige der Alternativen vorgestellt. Je nach Druckertreiber reicht es aus, die Papiergr�sse zu definieren. Ansonsten kann der Schacht definiert werden. Das folgende Beispiel sollte den manuellen Einzug aktivieren:
<pre>
uses Printers, WinSpool;

procedure TForm1.Button1Click(Sender: TObject);
var
aDevice : array[0..255] of char;
aDriver : array[0..255] of char;
aPort : array[0..255] of char;
hDMode : THandle;
PDMode : PDEVMODE;
begin
Printer.PrinterIndex := -1;
Printer.GetPrinter(aDevice, aDriver, aPort, hDMode);
if hDMode <> 0 then begin
pDMode := GlobalLock(hDMode);
if pDMode <> nil then begin
pDMode^.dmFields := pDMode^.dmFields or DM_PAPERSIZE;
pDMode^.dmPaperSize := DMPAPER_A4;
pDMode^.dmFields := pDMode^.dmFields or DM_DEFAULTSOURCE;
pDMode^.dmDefaultSource := DMBIN_MANUAL;
GlobalUnlock(hDMode);
end;
end;
with Printer do
begin
PrinterIndex := Printer.PrinterIndex;
BeginDoc;
Canvas.TextOut(100,100, 'Aus welchem Schacht kommt dieses Blatt?');
EndDoc;
end;
end;
</pre&gt

**Michael R. Sch�fer** · 14.11.1999, 13:32

Ich habe die kleine Routine ausprobiert, leider ohne den gew�nschten Erfolg.
Egal, was ich als DefaultSource (dmbin_cassette oder dmbin_lower usw.) einstelle, auf meinem Laserdrucker HP Laserjet 6p kommt das Papier immer aus dem manuellen Einzug (wenn dort Papier eingelegt ist). Wenn ich die Papierquelle im PrinterSetup einstelle, funktioniert es dagegen richtig.

Liegt es vielleicht an Windows NT 4.0 (SP 5) oder gibt es noch einen Trick??

**Andreas Kosch** · 15.11.1999, 15:45

Hallo,

dann probiere es bei Deinem Druckertreiber einmal auf die harte Tour - das dmField-Recordfeld wird komplett �berschrieben. Mit dem folgenden Aufruf kann ich unter NT 4 SP5 je nach Auskommentierung zwischen dem Standard-Einzug und dem manuellen Einzug wechseln.
<pre>
uses Printers, WinSpool;

procedure TForm1.Button1Click(Sender: TObject);
var
aDevice : array[0..255] of char;
aDriver : array[0..255] of char;
aPort : array[0..255] of char;
hDMode : THandle;
PDMode : PDEVMODE;
begin
Printer.PrinterIndex := -1;
Printer.GetPrinter(aDevice, aDriver, aPort, hDMode);
if hDMode <> 0 then begin
pDMode := GlobalLock(hDMode);
if pDMode <> nil then begin
pDMode^.dmFields := DM_DEFAULTSOURCE;
//pDMode^.dmDefaultSource := DMBIN_MANUAL;
pDMode^.dmDefaultSource := DMBIN_AUTO ;
GlobalUnlock(hDMode);
end;
end;
with Printer do
begin
PrinterIndex := Printer.PrinterIndex;
BeginDoc;
Canvas.TextOut(100,100, 'Aus welchem Schacht kommt dieses Blatt?');
EndDoc;
end;
end;
</pre&gt

**Sigurd Neumaier** · 19.11.1999, 14:13

Hallo,

ich hatte das gleiche Problem. Zus�tzlich ben�tigte ich die Liste der f�r den Drucker zur Verf�gung stehenden Papiergr��en und Papierquellen
unabh�ngig von einem bestehenden Setupdialog. Die folgende Unit inkl. eines Testprogramms l�st das Problem. Zus�tzlich liefert sie die Papiergr��en in 1/10 mm Einheiten und nicht in logischen Einheiten.
Die Unit war urspr�nglich f�r den C++-Builder geschrieben. Bei Bedarf hab ich den Code auch hierf�r zur Verf�gung.

unit mmprinter;

interface

uses Windows, Winspool, SysUtils, Classes, printers;

type
TmmPrinter = class(TPrinter)
protected
FPaperSources: TStrings;
FPaperSizes: TStrings;
FPaperSourceIndex: integer;
FPaperSizeIndex: integer;
ADevice: array[0..255] of char;
ADriver: array[0..255] of char;
APort: array[0..256] of char;
hDMode: THandle;

function GetPaperSizes: TStrings;
function GetPaperSources: TStrings;
procedure SetPaperSizeIndex(Value: integer);
procedure SetPaperSourceIndex(Value: integer);
function GetPageHeight_mm: integer;
function GetPageWidth_mm: integer;
public
constructor Create;
destructor Destroy; override;
property PaperSizes: TStrings read GetPaperSizes;
property PaperSources: TStrings read GetPaperSources;
property PaperSizeIndex: integer read FPaperSizeIndex write SetPaperSizeIndex;
property PaperSourceIndex: integer read FPaperSourceIndex write SetPaperSourceIndex;
property PageHeight_mm: integer read GetPageHeight_mm;
property PageWidth_mm: integer read GetPageWidth_mm;
end;

{
function mmPrinter: TmmPrinter;
function SetmmPrinter(NewPrinter: TmmPrinter): TmmPrinter;
}

implementation

uses Consts;

constructor TmmPrinter.Create;
begin
FPaperSizeIndex := -1;
FPaperSourceIndex := -1;
end;

destructor TmmPrinter.Destroy;
begin
FPaperSizes.Free;
FPaperSizes := nil;
FPaperSources.Free;
FPaperSources := nil;
end;

function TmmPrinter.GetPaperSources: TStrings;
var
pDevMode: PDeviceMode;
bin: array[0..255,0..23] of char;
i: DWORD;
Res: DWORD;
begin
if (FPaperSources = nil) then begin
try
FPaperSources := TStringList.Create;
except
FPaperSources.Free;
FPaperSources := nil;
raise;
end;
end;

FPaperSources.Clear;
GetPrinter(ADevice,ADriver,APort,hDMode);
pDevMode := nil;
{Res := DeviceCapabilities(ADevice,APort,DC_BINNAMES,bin[0][0],pDevMode);}
for i := 0 to Res-1 do begin
FPaperSources.Add(bin[i]);
end;

Result := FPaperSources;
end;

function TmmPrinter.GetPaperSizes: TStrings;
var
pDevMode: PDeviceMode;
pl: array[0..255,0..63] of char;
i: DWORD;
Res: DWORD;
begin
if (FPaperSizes = nil) then begin
try
FPaperSizes := TStringList.Create;
except
FPaperSizes.Free;
FPaperSizes := nil;
raise;
end;
end;
FPaperSizes.Clear;
GetPrinter(ADevice,ADriver,APort,hDMode);
{Res = DeviceCapabilities(ADevice,APort,DC_PAPERNAMES,&(p l[0][0]),pDevMode);}
for i := 0 to Res-1 do begin
FPaperSizes.Add(pl[i]);
end;
Result := FPaperSizes;
end;

function TmmPrinter.GetPageHeight_mm: integer;
var
pDevMode: PDeviceMode;
p: array [0..99] of TPoint;
Res: DWORD;
begin
GetPrinter(ADevice,ADriver,APort,hDMode);
{Res = DeviceCapabilities(ADevice,APort,DC_PAPERSIZE,(LPT STR)&(p[0]),pDevMode);}
if (FPaperSizeIndex <= Res) then begin
Result := p[FPaperSizeIndex].y;
end
else begin
Result := 0;
end;
end;

function TmmPrinter.GetPageWidth_mm: integer;
var
pDevMode: PDeviceMode;
p: array [0..99] of TPoint;
Res: DWORD;
begin
GetPrinter(ADevice,ADriver,APort,hDMode);
{Res = DeviceCapabilities(ADevice,APort,DC_PAPERSIZE,(LPT STR)&(p[0]),pDevMode);}

19.11.1999, 14:25

Hallo,

ich hatte das gleiche Problem. Zus�tzlich ben�tigte ich die Liste der f�r den Drucker zur Verf�gung stehenden Papiergr��en und Papierquellen unabh�ngig von einem bestehenden Setupdialog. Die folgende Unit l�st das Problem. Zus�tzlich liefert sie die Papiergr��en in 1/10 mm Einheiten und nicht in logischen Einheiten. Die Unit war urspr�nglich f�r den C++-Builder geschrieben. Bei Bedarf hab ich den Code auch hierf�r zur Verf�gung.

unit mmprinters; 

interface 

uses Windows, Winspool, SysUtils, Classes, printers; 

type 
TmmPrinter = class(TPrinter) 
protected 
FPaperSources: TStrings; 
FPaperSizes: TStrings; 
FPaperSourceIndex: integer; 
FPaperSizeIndex: integer; 
ADevice: array[0..255] of char; 
ADriver: array[0..255] of char; 
APort: array[0..256] of char; 
hDMode: THandle; 

function GetPaperSizes: TStrings; 
function GetPaperSources: TStrings; 
procedure SetPaperSizeIndex(Value: integer); 
procedure SetPaperSourceIndex(Value: integer); 
function GetPageHeight_mm: integer; 
function GetPageWidth_mm: integer; 
public 
constructor Create; 
destructor Destroy; override; 
property PaperSizes: TStrings read GetPaperSizes; 
property PaperSources: TStrings read GetPaperSources;
property PaperSizeIndex: integer read FPaperSizeIndex write SetPaperSizeIndex; 
property PaperSourceIndex: integer read FPaperSourceIndex write SetPaperSourceIndex; 
property PageHeight_mm: integer read GetPageHeight_mm; 
property PageWidth_mm: integer read GetPageWidth_mm; 
end; 

function mmPrinter: TmmPrinter; 
function SetmmPrinter(NewPrinter: TmmPrinter): TmmPrinter; 

implementation 

uses Consts; 
var 
FmmPrinter: TmmPrinter = nil; 

constructor TmmPrinter.Create; 
begin 
FPaperSizeIndex := -1; 
FPaperSourceIndex := -1; 
end; 

destructor TmmPrinter.Destroy; 
begin 
FPaperSizes.Free; 
FPaperSizes := nil; 
FPaperSources.Free; 
FPaperSources := nil; 
end; 

function TmmPrinter.GetPaperSources: TStrings; 
var 
pDevMode: PDeviceMode; 
bin: array[0..255,0..23] of char; 
i: DWORD; 
Res: DWORD; 
begin 
if (FPaperSources = nil) then begin 
try 
FPaperSources := TStringList.Create; 
except 
FPaperSources.Free; 
FPaperSources := nil; 
raise; 
end; 
end; 

FPaperSources.Clear; 
GetPrinter(ADevice,ADriver,APort,hDMode); 
pDevMode := nil; 
Res := DeviceCapabilities(ADevice,APort,DC_BINNAMES,PCHAR (@(bin[0][0])),pDevMode); 
for i := 0 to Res-1 do begin 
FPaperSources.Add(bin[i]); 
end; 

Result := FPaperSources; 
end; 

function TmmPrinter.GetPaperSizes: TStrings; 
var 
pDevMode: PDeviceMode; 
pl: array[0..255,0..63] of char; 
i: DWORD; 
Res: DWORD; 
begin 
if (FPaperSizes = nil) then begin 
try 
FPaperSizes := TStringList.Create; 
except 
FPaperSizes.Free; 
FPaperSizes := nil; 
raise; 
end; 
end; 
FPaperSizes.Clear; 
GetPrinter(ADevice,ADriver,APort,hDMode); 
pDevMode := nil; 
Res := DeviceCapabilities(ADevice,APort,DC_PAPERNAMES,PCH AR(@(pl[0][0])),pDevMode); 
for i := 0 to Res-1 do begin 
FPaperSizes.Add(pl[i]); 
end; 
Result := FPaperSizes; 
end; 

&#10

19.11.1999, 14:39

function TmmPrinter.GetPageHeight_mm: integer; 
var 
pDevMode: PDeviceMode; 
p: array [0..99] of TPoint; 
Res: DWORD; 
begin 
GetPrinter(ADevice,ADriver,APort,hDMode); 
pDevMode := nil; 
Res := DeviceCapabilities(ADevice,APort,DC_PAPERSIZE,PCHA R(@p[0]),pDevMode); 
if (FPaperSizeIndex <= integer(Res)) then begin 
Result := p[FPaperSizeIndex].y; 
end 
else begin 
Result := 0; 
end; 
end; 

function TmmPrinter.GetPageWidth_mm: integer; 
var 
pDevMode: PDeviceMode; 
p: array [0..99] of TPoint; 
Res: DWORD; 
begin 
GetPrinter(ADevice,ADriver,APort,hDMode); 
pDevMode := nil; 
Res := DeviceCapabilities(ADevice,APort,DC_PAPERSIZE,PCHA R(@p[0]),pDevMode); 
if (FPaperSizeIndex <= integer(Res)) then begin 
Result := p[FPaperSizeIndex].x; 
end 
else begin 
Result := 0; 
end; 
end; 

procedure TmmPrinter.SetPaperSizeIndex(Value: integer); 
var 
pDevMode : PDeviceMode; 
p: array [0..99] of WORD; 
Res: DWORD; 
begin 
if (Printing) then raise EPrinter.Create(SPrinting); 
if ((Value < 0) or (Value >= PaperSizes.Count)) then exit; 
FPaperSizeIndex := Value; 
GetPrinter(ADevice,ADriver,APort,hDMode); 
{ 
Ohne Handle auf eine DevMode-Struktur geht nichts. Deshalb wird durch den Aufruf
von SetPrinter das Handle besorgt 
} 
if (hDMode = 0) then begin 
SetPrinter(ADevice,ADriver,APort,hDMode); 
GetPrinter(ADevice,ADriver,APort,hDMode); 
end; 
pDevMode := nil; 
Res := DeviceCapabilities(ADevice,APort,DC_PAPERS,PCHAR(@ p[0]),pDevMode); 
if (FPaperSizeIndex <= integer(Res)) then begin 
if (hDMode <> 0) then begin 
pDevMode := GlobalLock(hDMode); 
if (pDevMode <> nil) then begin 
pDevMode^.dmPaperSize := p[FPaperSizeIndex]; 
end; 
GlobalUnlock(hDMode); 
end; 
end; 
end; 

procedure TmmPrinter.SetPaperSourceIndex(Value: integer); 
var 
pDevMode : PDeviceMode; 
p: array [0..99] of WORD; 
Res: DWORD; 
begin 
if (Printing) then raise EPrinter.Create(SPrinting); 
if ((Value < 0) or (Value >= PaperSources.Count)) then exit; 
FPaperSourceIndex := Value; 
GetPrinter(ADevice,ADriver,APort,hDMode); 
{ 
Ohne Handle auf eine DevMode-Struktur geht nichts. Deshalb wird durch den Aufruf
von SetPrinter das Handle besorgt 
} 
if (hDMode = 0) then begin 
SetPrinter(ADevice,ADriver,APort,hDMode); 
GetPrinter(ADevice,ADriver,APort,hDMode); 
end; 
pDevMode := nil; 
Res := DeviceCapabilities(ADevice,APort,DC_BINS,PCHAR(@p[0]),pDevMode); 
if (FPaperSourceIndex <= integer(Res)) then begin 
if (hDMode <> 0) then begin 
pDevMode := GlobalLock(hDMode); 
if (pDevMode <> nil) then begin 
pDevMode^.dmFields := (DM_DEFAULTSOURCE or DM_PAPERSIZE); 
pDevMode^.dmDefaultSource := p[FPaperSourceIndex]; 
end; 
GlobalUnlock(hDMode); 
end; 
end; 
end; 

function mmPrinter: TmmPrinter; 
begin 
if (FmmPrinter = nil) then FmmPrinter := TmmPrinter.Create; 
Result := FmmPrinter; 
end; 

function SetmmPrinter(NewPrinter: TmmPrinter): TmmPrinter; 
begin 
Result := FmmPrinter; 
FmmPrinter := NewPrinter; 
end; 

end.<br&gt

**Carsten Jockenh�fer** · 01.12.1999, 14:19

Und wenn alles nicht funktioniert (mit Spezialdruckern-TT und speziellen Properties), dann lege einfach mehrere Drucker in der Druckersteuerung an, die die entsprechend konfigurierten Eigenschaften besitzen. Quick and dirty.

Mfg Carsten Jockenh�fe

Announcement

Auswahl des Druckerschachtes

Auswahl des Druckerschachtes

Comment

Comment

Comment

Comment

Comment

Comment

Comment