How to change the printer resolution (Views: 28)
Problem/Question/Abstract: 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. uses winspool, Printers; {$R *.DFM} type TPrinterResolution = record resx, resY: Longint; end; TPrinterResolutions = array of TPrinterResolution; function GetPrinterResolutions: TPrinterResolutions; var numResolutions: Integer; Device, Driver, Port: array[0..255] of Char; hDevMode: THandle; begin Printer.GetPrinter(Device, Driver, Port, hDevmode); numResolutions := WinSpool.DeviceCapabilities(Device, Port, DC_ENUMRESOLUTIONS, nil, nil); SetLength(Result, numResolutions); if numResolutions > 0 then begin WinSpool.DeviceCapabilities(Device, Port, DC_ENUMRESOLUTIONS, @Result[0], nil); end; end; procedure TForm1.FormCreate(Sender: TObject); var resarray: TPrinterResolutions; i: Integer; begin resArray := GetPrinterResolutions; for i := 0 to Length(resarray) - 1 do begin {create a radiobutton for each resolution, pack the actual resolution into its Tag property} radiogroup1.Items.add(format('%d x %d dpi', [resarray[i].resX, resarray[i].resY])); radiogroup1.Controls[i].Tag := MakeLong(LoWord(resarray[i].resX), LoWord(resarray[i].resY)); end; if radiogroup1.items.count > 0 then begin radiogroup1.itemindex := 0; radiogroup1.clientheight := radiogroup1.ControlCount * radiogroup1.controls[0].height; end else button1.enabled := false; end; procedure TForm1.Button1Click(Sender: TObject); var Device, Driver, Port: array[0..255] of Char; hDevMode: THandle; pDevMode: PDeviceMode; dw: DWORD; begin with radiogroup1 do dw := Controls[itemindex].Tag; {test print using selected resolution} Printer.GetPrinter(Device, Driver, Port, hDevmode); {force reset of devmode} Printer.SetPrinter(Device, Driver, Port, 0); Printer.GetPrinter(Device, Driver, Port, hDevmode); if hDevmode <> 0 then begin pDevmode := GlobalLock(hDevmode); if pDevmode <> nil then try pDevMode^.dmPrintQuality := LoWord(dw); pDevmode^.dmYResolution := HiWord(dw); pDevmode^.dmFields := pDevmode^.dmFields or DM_PRINTQUALITY or DM_YRESOLUTION; finally GlobalUnlock(hDevmode); end; Printer.beginDoc; try with Printer.Canvas.Font do begin Name := 'Arial'; Size := 24; end; {print test string 1 inch from margins} Printer.Canvas.textOut(LoWord(dw), HiWord(dw), 'This is a test'); finally Printer.endDoc; end; end; end; |