Author: Jonas Bilinkevicius
I'm trying to change the print resolution of TPrinter from my application. But it
works only if I change this parameter in a TPrintDialog. Commands like
"Printer.Canvas.Font.PixelsPerInch := NewResolution" don't work.
Answer:
The first step is to find out which resolutions the printer supports. You do that
via Winspool.Devicecapabilities. You select one of the available settings and the
modify two fields of the printers devmode structure accordingly.
Create a new project, drop a TRadiogroup and a TButton on it, leave the radiogroup
empty. Add handlers for the forms OnCreate event and the buttons OnClick.
1 uses
2 winspool, Printers;
3
4 {$R *.DFM}
5
6 type
7 TPrinterResolution = record
8 resx, resY: Longint;
9 end;
10 TPrinterResolutions = array of TPrinterResolution;
11
12 function GetPrinterResolutions: TPrinterResolutions;
13 var
14 numResolutions: Integer;
15 Device, Driver, Port: array[0..255] of Char;
16 hDevMode: THandle;
17 begin
18 Printer.GetPrinter(Device, Driver, Port, hDevmode);
19 numResolutions := WinSpool.DeviceCapabilities(Device, Port, DC_ENUMRESOLUTIONS,
20 nil,
21 nil);
22 SetLength(Result, numResolutions);
23 if numResolutions > 0 then
24 begin
25 WinSpool.DeviceCapabilities(Device, Port, DC_ENUMRESOLUTIONS, @Result[0], nil);
26 end;
27 end;
28
29 procedure TForm1.FormCreate(Sender: TObject);
30 var
31 resarray: TPrinterResolutions;
32 i: Integer;
33 begin
34 resArray := GetPrinterResolutions;
35 for i := 0 to Length(resarray) - 1 do
36 begin
37 {create a radiobutton for each resolution, pack the actual resolution into
38 its Tag property}
39 radiogroup1.Items.add(format('%d x %d dpi', [resarray[i].resX,
40 resarray[i].resY]));
41 radiogroup1.Controls[i].Tag := MakeLong(LoWord(resarray[i].resX),
42 LoWord(resarray[i].resY));
43 end;
44 if radiogroup1.items.count > 0 then
45 begin
46 radiogroup1.itemindex := 0;
47 radiogroup1.clientheight := radiogroup1.ControlCount *
48 radiogroup1.controls[0].height;
49 end
50 else
51 button1.enabled := false;
52 end;
53
54 procedure TForm1.Button1Click(Sender: TObject);
55 var
56 Device, Driver, Port: array[0..255] of Char;
57 hDevMode: THandle;
58 pDevMode: PDeviceMode;
59 dw: DWORD;
60 begin
61 with radiogroup1 do
62 dw := Controls[itemindex].Tag;
63 {test print using selected resolution}
64 Printer.GetPrinter(Device, Driver, Port, hDevmode);
65 {force reset of devmode}
66 Printer.SetPrinter(Device, Driver, Port, 0);
67 Printer.GetPrinter(Device, Driver, Port, hDevmode);
68 if hDevmode <> 0 then
69 begin
70 pDevmode := GlobalLock(hDevmode);
71 if pDevmode <> nil then
72 try
73 pDevMode^.dmPrintQuality := LoWord(dw);
74 pDevmode^.dmYResolution := HiWord(dw);
75 pDevmode^.dmFields := pDevmode^.dmFields or DM_PRINTQUALITY or DM_YRESOLUTION;
76 finally
77 GlobalUnlock(hDevmode);
78 end;
79 Printer.beginDoc;
80 try
81 with Printer.Canvas.Font do
82 begin
83 Name := 'Arial';
84 Size := 24;
85 end;
86 {print test string 1 inch from margins}
87 Printer.Canvas.textOut(LoWord(dw), HiWord(dw), 'This is a test');
88 finally
89 Printer.endDoc;
90 end;
91 end;
92 end;
|