Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi Aktuelles Papierformat auslesen/setzen? (https://www.delphipraxis.net/70143-aktuelles-papierformat-auslesen-setzen.html)

PeterPanino 25. Mai 2006 19:04


Aktuelles Papierformat auslesen/setzen?
 
Hallo,

weiß jemand, wie man das aktuelle Papierformat des aktuellen Druckers als String auslesen und dann wieder einstellen kann?

Vielen Dank im Voraus!
Peter

RWarnecke 25. Mai 2006 19:13

Re: Aktuelles Papierformat auslesen/setzen?
 
Hallo,

schau Dir das hier mal an. Oder dieses hier an. Vielleicht helfen Dir die beiden Links weiter.

PeterPanino 25. Mai 2006 19:49

Re: Aktuelles Papierformat auslesen/setzen?
 
Zitat:

Zitat von RWarnecke
Hallo,

schau Dir das hier mal an. Oder dieses hier an. Vielleicht helfen Dir die beiden Links weiter.

Vielen Dank! Mit dem Code aus dem 2. Link kann man die Liste der Papierformate des aktuellen Druckers auslesen.

Wie kann man aber das aktuelle Papierformat auslesen?

Peter

Hawkeye219 25. Mai 2006 22:40

Re: Aktuelles Papierformat auslesen/setzen?
 
Hallo Peter,

bei den Schweizern fand ich auch die folgende Routine (Direktlink):

Delphi-Quellcode:
uses
  Printers, WinSpool;

procedure TForm1.Button1Click(Sender: TObject);
var
  Dev, Drv, Prt: array[0..255] of Char;
  DM1: PDeviceMode;
  DM2: PDeviceMode;
  Sz: Integer;
  DevM: THandle;
begin
  Printer.PrinterIndex := -1;
  Printer.GetPrinter(Dev, Drv, Prt, DevM);
  DM1 := nil;
  DM2 := nil;
  Sz := DocumentProperties(0, 0, Dev, DM1^, DM2^, 0);
  GetMem(DM1, Sz);
  DocumentProperties(0, 0, Dev, DM1^, DM2^, DM_OUT_BUFFER);
  if DM1^.dmColor > 1 then
    label1.Caption := Dev + ': Color'
  else
    label1.Caption := Dev + ': Black and White';
  if DM1^.dmFields and DM_Color <> 0 then
    Label2.Caption := 'Printer supports color printing'
  else
    Label2.Caption := 'Printer does not support color printing';
  FreeMem(DM1);
end;
Über die Variable DM1 kannst du auf alle Informationen über den Drucker zugreifen. Die Papiergröße kann über DM1.dmPaperSize abgefragt werden, die dabei verwendeten Konstanten (z.B. DMPAPER_A4 = 9) sind in der Unit Windows.pas definiert.

Prinzipiell könnte man über die Funktion DocumentProperties auch die Papiergröße einstellen. Ich kann dir aber leider nicht sagen, ob die Unit Printers diese Einstellung dann auch benutzt.

Gruß Hawkeye

PeterPanino 26. Mai 2006 12:42

Re: Aktuelles Papierformat auslesen/setzen?
 
Vielen Dank!

Wenn ich in dieser Routine folgenden Code einsetze:

Delphi-Quellcode:
Label3.Caption := DM1^.dmFormName;
wird dafür immer 'A4 210 x 297 mm' (das Default-Papierformat für diesen Drucker) ausgegeben, unabhängig davon, welches Papierformat ich im Laufzeit-DruckerSetup-Dialog des Programmes einstelle! Wie kann man nun das aktuell eingestellte Papierformat erfahren?

Peter

PeterPanino 27. Mai 2006 01:26

Re: Aktuelles Papierformat auslesen/setzen?
 
Liste der Anhänge anzeigen (Anzahl: 1)
Eureka - nach vielen Stunden Recherche habe ich endlich eine Lösung zusammengebastelt, die funktioniert:

Delphi-Quellcode:
type
  TPaperName = array[0..63] of Char;
  TPaperInfo = packed record
    papername: TPapername;
    paperID: Word;
    papersize: TPoint;
  end;
  TPaperInfos = array of TPaperInfo;
  TPaperSizes = array of TPoint;

function GetPaperID: SmallInt;
var
  Device, Driver, Port: array[0..127] of char;
  hDeviceMode: THandle;
  pDevMode: PDeviceMode;
begin
  with Printer do
  begin
    GetPrinter(Device, Driver, Port, hDeviceMode);
    pDevMode := GlobalLock(hDevicemode);
    if pDevMode <> nil then
    try
      with pDevMode^ do
      begin
        dmFields := dmFields or DM_PAPERSIZE;
        Result := dmPapersize;
      end;
    finally
      GlobalUnlock(hDevicemode);
    end;
  end;
end;

procedure GetPapernames(sl: TStrings; index: Integer);
type
  TPaperNameArray = array[1..High(Integer) div Sizeof(TPaperName)] of TPaperName;
  PPapernameArray = ^TPaperNameArray;
  TPaperArray = array[1..High(Integer) div Sizeof(Word)] of Word;
  PPaperArray = ^TPaperArray;
var
  Device, Driver, Port: array[0..255] of Char;
  hDevMode: THandle;
  i, numPaperNames, numPapers, temp: Integer;
  pPaperNames: PPapernameArray;
  pPapers: PPaperArray;
begin
  Assert(Assigned(sl));
  Printer.PrinterIndex := index;
  Printer.GetPrinter(Device, Driver, Port, hDevmode);
  numPaperNames := WinSpool.DeviceCapabilities(Device, Port, DC_PAPERNAMES, nil, nil);
  numPapers := WinSpool.DeviceCapabilities(Device, Port, DC_PAPERS, nil, nil);
  if numPapers <> numPaperNames then
  begin
    raise Exception.Create('DeviceCapabilities reports different number of papers and paper-names');
  end;
  if numPaperNames > 0 then
  begin
    GetMem(pPaperNames, numPaperNames * Sizeof(TPapername));
    GetMem(pPapers, numPapers * Sizeof(Word));
    try
      WinSpool.DeviceCapabilities(Device, Port, DC_PAPERNAMES, Pchar(pPaperNames),
        nil);
      WinSpool.DeviceCapabilities(Device, Port, DC_PAPERS, Pchar(pPapers), nil);
      sl.clear;
      for i := 1 to numPaperNames do
      begin
        temp := pPapers^[i];
        sl.addObject(pPaperNames^[i], TObject(temp));
      end;
    finally
      FreeMem(pPaperNames);
      if pPapers <> nil then
        FreeMem(pPapers);
    end;
  end;
end;
 
procedure GetPapersizes(var sizes: TPaperSizes; index: Integer);
var
  Device, Driver, Port: array[0..255] of Char;
  hDevMode: THandle;
  numPapers: Integer;
begin
  Printer.PrinterIndex := index;
  Printer.GetPrinter(Device, Driver, Port, hDevmode);
  numPapers := WinSpool.DeviceCapabilities(Device, Port, DC_PAPERS, nil, nil);
  SetLength(sizes, numPapers);
  if numPapers > 0 then
    WinSpool.DeviceCapabilities(Device, Port, DC_PAPERSIZE, PChar(@sizes[0]), nil);
end;
 
procedure GetPaperInfo(var infos: TPaperInfos; index: Integer);
var
  sizes: TPaperSizes;
  sl: TStringlist;
  i: Integer;
begin
  sl := Tstringlist.Create;
  try
    GetPaperNames(sl, index);
    GetPaperSizes(sizes, index);
    Assert(sl.count = Length(sizes));
    SetLength(infos, sl.count);
    for i := 0 to sl.count - 1 do
    begin
      StrPLCopy(infos[i].papername, sl[i], Sizeof(TPapername) - 1);
      infos[i].paperID := LoWord(Longword(sl.Objects[i]));
      infos[i].papersize := sizes[i];
    end;
  finally
    sl.Free;
  end;
end;

procedure TForm1.btnDruckerEinstellenClick(Sender: TObject);
var
  i, PaperID: integer;
  Papers: TPaperInfos;
begin
  if PrinterSetupDialog.Execute then
  begin
    PaperID := GetPaperID;
    GetPaperInfo(Papers, Printer.PrinterIndex);
    for i := Low(Papers) to High(Papers) do
    begin
      if PaperID = Papers[i].paperID then
      begin
        label1.Caption := Papers[i].papername;
        BREAK;
      end;
    end;
  end;
end;

Tod787 23. Jun 2010 09:20

AW: Aktuelles Papierformat auslesen/setzen?
 
Benötige auch eine Funktion um das Papierformat von Druckern zu ermitteln und den Code mal ausprobiert. Leider bekomme ich bei allen Druckern immer DinA4 angezeigt.

Habe vor eine Combobox mit den Druckern zu erstellen mit der ich die Papierformate aller Drucker auslesen kann.

Aufruf:
Delphi-Quellcode:
procedure TForm1.ComboBoxChange(Sender: TObject);
var
  i, PaperID: integer;
  Papers: TPaperInfos;
begin
  Printer.PrinterIndex := ComboBox.ItemIndex;
  PaperID := GetPaperID;
  GetPaperInfo(Papers, Printer.PrinterIndex);
  for i := Low(Papers) to High(Papers) do
  begin
    if PaperID = Papers[i].paperID then
    begin
      label1.Caption := Papers[i].papername;
      BREAK;
    end;
  end;
end;

RWarnecke 23. Jun 2010 10:38

AW: Aktuelles Papierformat auslesen/setzen?
 
Hallo zusammen,

mit der Komponente TPrinterInfo gibt es Liste mit allen möglichen Papierformaten des ausgewählten Druckers aus.

Tod787 23. Jun 2010 11:41

AW: Aktuelles Papierformat auslesen/setzen?
 
Hallo RWarnecke

die von dir genannte Komponente würde ich liebend gerne installieren nur leider bekomme ich immer die Fehlermeldung

Zitat:

Zugriffsverletzung bei Adresse 400702F in Modul 'rtl70.bpl'. Lesen von Adresse 0477FCFE
Vermutlich mache ich bei der Installation was falsch wobei das bei anderen Komponenten nicht der Fall war.


Alle Zeitangaben in WEZ +1. Es ist jetzt 15:16 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz