[D7] Lister les résolution d'une imprimante

J'ai trouvé une solution:

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;

Je pense qu'on peut difficilement faire mieux, nan ?

[ Lien ]