Текущий архив: 2004.09.12;
Скачать: CL | DM;

Вниз

Как получить текущий DEVMODE принтера   Найти похожие ветки 

← →
OlkaGTS   (2004-07-28 14:06) [0]

Можно ли как-нибудь получить текущий DEVMODE принтера не используя
Printer.PrinterIndex := Printer.PrinterIndex;
Printer.GetPrinter(Device, Driver, Port, hDMode); и т.д.
Проблема в том, что текущий принтер менять на данном этапе нельзя

---

← →
Alex Konshin ©   (2004-07-29 10:21) [1]

// 1999-2003, Alex Konshin <akonshin@earthlink.net>
unit PrintLib;

interface

uses
 SysUtils, Windows, Classes, Graphics, WinSpool;

function GetPrinterHandle : THandle;
function GetDevMode : PDeviceMode;
procedure GetPrinterForms( const hPrinter : THandle; AFormNames : TStrings );
procedure SetPrinterForm( const AFormName : String );

procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer; const Text: string; Alignment: TAlignment);
procedure DrawFrame( const ARect : TRect );

//=============================================================
implementation

uses Printers, Dialogs, Forms;

type
 PHandle = ^THandle;
 PPDeviceMode = ^PDeviceMode;
 THackPrinterDevice = class
   FDriver, FDevice, FPort : String;
 end;

function DocumentProperties(hWnd: HWND; hPrinter: THandle; pDeviceName: PChar;
 pDevModeOutput: PDeviceMode; pDevModeInput: PDeviceMode;
 fMode: DWORD): Longint; stdcall; external "winspool.drv" name "DocumentPropertiesA";

//=============================================================
function GetPrinterHandle : THandle;
var oPrinter : TPrinter;
begin
 oPrinter := Printer;
 if oPrinter.PrinterIndex = -1 then Result := 0
 else Result := PHandle(PChar(oPrinter)+oPrinter.InstanceSize-4)^;
end;
//-------------------------------------------------------------
function GetDevMode : PDeviceMode;
var
 oPrinter : TPrinter;
begin
 oPrinter := Printer;
 if oPrinter.PrinterIndex=-1 then Result := nil
 else if PHandle(PChar(oPrinter)+oPrinter.InstanceSize-8)^=0 then Result := nil
 else Result := PPDeviceMode(PChar(oPrinter)+oPrinter.InstanceSize-12)^;
end;
//-------------------------------------------------------------
procedure GetPrinterForms( const hPrinter : THandle; AFormNames : TStrings );
var pForm, pBuf : PFormInfo1A;
   cbBuf,n,i,rc : DWORD;
begin
 if AFormNames=nil then Exit;
 AFormNames.Clear;
 if hPrinter=0 then Exit;
 try
   EnumFormsA(hPrinter,1,nil,0,cbBuf,n);
   rc := GetLastError;
   if rc<>122 then MessageDlg(SysErrorMessage(rc),mtError,[mbOk],0)
   else
     begin
       GetMem(pBuf,cbBuf);
       try
         pForm := pBuf;
         if not EnumFormsA(hPrinter,1,pForm,cbBuf,cbBuf,n) then MessageDlg(SysErrorMessage(GetLastError),mtError,[mbOk],0)
         else if n>0 then with AFormNames do
           for i := 0 to n-1 do
           begin
             Add(pForm^.pName);
             Inc(PChar(pForm),SizeOf(TFormInfo1A));
           end;
       finally
         FreeMem(pBuf);
       end;
     end;
 except
   on E:Exception do
   begin
     Windows.MessageBox( Application.Handle,
       PChar("Error on EnumForms:"#13#10+E.ClassName+": "+E.Message),
       "Error", MB_OK or MB_ICONERROR or MB_DEFBUTTON1 or MB_SETFOREGROUND or MB_TASKMODAL);
   end;
 end;
end;
//-------------------------------------------------------------
procedure SetPrinterForm( const AFormName : String );
var oPrinter : TPrinter;
   hPrinter : THandle;
   idx : Integer;
   sDeviceName : String;
   pDevMode : PDeviceMode;
   rDevMode : TDeviceModeA;
begin
 if AFormName="" then Exit;
 oPrinter := Printer;
 idx := oPrinter.PrinterIndex;
 if (idx = -1)or(PHandle(PChar(oPrinter)+oPrinter.InstanceSize-8)^=0) then Exit;
 hPrinter := PHandle(PChar(oPrinter)+oPrinter.InstanceSize-4)^;
 pDevMode := GetDevMode;
 if pDevMode=nil then
 begin
   Windows.MessageBox( Application.Handle,
     PChar("Printer is not installed."),
     "Error", MB_OK or MB_ICONERROR or MB_DEFBUTTON1 or MB_SETFOREGROUND or MB_TASKMODAL);
   Exit;
 end;
 try
   Move(pDevMode^,rDevMode,SizeOf(TDeviceModeA));
   with rDevMode do
   begin
     dmFields := DM_FORMNAME;
     FillChar(dmFormName,CCHFORMNAME,#0);
     StrLCopy(dmFormName,PChar(AFormName),CCHFORMNAME);
   end;
   sDeviceName := THackPrinterDevice(oPrinter.Printers.Objects[idx]).FDevice;
   if DocumentProperties(0,hPrinter,PChar(sDeviceName),pDevMode,@rDevMode,DM_IN_BUFFER or DM_OUT_BUFFER)<0 then
   begin
     Windows.MessageBox( Application.Handle,
       PChar("Error on setting printer properties: "#13#10+SysErrorMessage(GetLastError)),
       "Error", MB_OK or MB_ICONERROR or MB_DEFBUTTON1 or MB_SETFOREGROUND or MB_TASKMODAL);
     Exit;
   end;
 except
   on E:Exception do
   begin
     Windows.MessageBox( Application.Handle,
       PChar("Error on setting printer properties: "#13#10+E.ClassName+": "+E.Message),
       "Error", MB_OK or MB_ICONERROR or MB_DEFBUTTON1 or MB_SETFOREGROUND or MB_TASKMODAL);
   end;
 end;
end;
//-------------------------------------------------------------
procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer; const Text: string; Alignment: TAlignment);
const
 AlignFlags : array [TAlignment] of Integer =
   ( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
     DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
     DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
var
 Left: Integer;
begin
 case Alignment of
 taLeftJustify: Left := ARect.Left + DX;
 taRightJustify: Left := ARect.Right - ACanvas.TextWidth(Text) - 3;
 else { taCenter }
   Left := ARect.Left + (ARect.Right - ARect.Left) shr 1 - (ACanvas.TextWidth(Text) shr 1);
 end;
 ExtTextOut(ACanvas.Handle, Left, ARect.Top + DY, ETO_OPAQUE or ETO_CLIPPED, @ARect, PChar(Text), Length(Text), nil);
end;
//-------------------------------------------------------------
procedure DrawFrame( const ARect : TRect );
begin
 Printer.Canvas.Brush.Color := clBlack;
 Printer.Canvas.FrameRect(ARect);
 Printer.Canvas.Brush.Color := clWhite;
end;

end.


---

← →
Alex Konshin ©   (2004-07-29 10:32) [2]

Но помню, что была там какая-то засада.

---

Страницы: 1 вся ветка

Текущий архив: 2004.09.12;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.055 c