Discussion :

[hlmhv]

Bonjour à tou(te)s!

Je cherche à choisir une imprimante parmi celles qui sont branchées au PC (en local donc) sans passer par le TPrintDialog, ceci afin qu'une tâche d'impression achevée, la seconde ne soit pas automatiquement redirigée vers la même imprimante (la dernière fois, ma petite imprimante d'étiquette a voulu imprimer mon courrier.. ).

Je pensais que TPrinter possédait des méthodes pour choisir l'imprimante, mais bernique!


Que fais-je?

Ah oui! Je bosse sur CodeGear 2007 uniquement en Win32..

[Jipété]

Du web :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
// http://bdn.borland.com/article/28936
{This sample is for Windows 2000 or NT but you should be able
to adapt this code to your needs.
The call to SendMessage notifies any other apps that are running
that the default printer has changed.
Sometimes this can cause the app to "freeze" because it is waiting
for a reply from each app (which it may never get)
so the code is commented out here.
You can determine whether you need it or not.  }
 
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;
 
const
  MAXPRINTERBUFFER = 8000;
  MAXPRINTERNAME = 500;
  MAXPRINTERINFO = 50;
 
type
  TPrinterBuffer = array[0..MAXPRINTERBUFFER - 1] of char;
  TForm1 = class(TForm)
  ListBox1: TListBox;
  Button2: TButton;
  Button1: TButton;
  Label1: TLabel;
  procedure Button2Click(Sender: TObject);
  procedure GetPrinterNames;
  function ParseNames(const namebuffer: TPrinterBuffer; var startPos: integer): string;
  function SetPrinter(const PrinterName : String) : boolean;
  procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  printerNames: TStringList;
  defaultPrinter: integer;
 
implementation
 
{$R *.DFM}
 
procedure TForm1.Button2Click(Sender: TObject);
var
  x : integer;
begin
  try
  for x := 0 to printerNames.Count -1 do begin
    If ListBox1.Selected[x] then begin
      if (SetPrinter(ListBox1.Items.Strings[x]))
      then label1.Caption := 'Printer set to ' + ListBox1.Items.Strings[x]
      else label1.Caption := 'Printer not set';
    end;
  end;
  except
    label1.Caption := 'An error occured while setting the printer';
  end;
end;
 
procedure TForm1.GetPrinterNames;
var
  buffer: TPrinterBuffer;
  currPos: integer;
  printerName: string;
begin
  printerNames.Free;
  printerNames := TStringList.Create;
  if GetProfileString(PChar('PrinterPorts'), nil, '', buffer, MAXPRINTERBUFFER) > 0 then
  begin
    currPos := 0;
    while (true) do
      begin
        printerName := ParseNames(buffer, currPos);
        if printerName <> '' then
        printerNames.Add(printerName)
    else
      break;
    end;
  end;
end;
 
function TForm1.ParseNames(const namebuffer: TPrinterBuffer;
var startPos: integer): string;
var
  i, j, NameLength: integer;
  str: string;
begin
  result := '';
  if (startPos > High(namebuffer)) or (namebuffer[startPos] = Chr(0))  
 
  then
    exit;
  for i := startPos to High(namebuffer) do begin
    if namebuffer[i] = Chr(0) 
 
    then begin
      nameLength := i - startPos;
      SetLength(str, nameLength);
      for j := 0 to nameLength - 1 do
      str[j+1] := namebuffer[startPos + j];
      result := str;
      startPos := i + 1;
      break;
    end;
  end;
end;
 
function TForm1.SetPrinter(const PrinterName: String): boolean;
var
  s2 : string;
  dum1 : Pchar;  
  xx, qq : integer;
const
  cs1 : pchar = 'Windows';
  cs2 : pchar = 'Device';
  cs3 : pchar = 'Devices';
  cs4 : pchar = #0;
 
begin
  xx := 254;
  GetMem( dum1, xx);
  Result := False;
  try
    qq := GetProfileString( cs3, pchar( printerName ), #0, dum1, xx);
    if (qq > 0) and (trim( strpas( dum1 )) <> '') 
 
   then begin
      s2 := PrinterName + ',' + strpas( dum1 );
      while GetProfileString( cs1, cs2, cs4, dum1, xx) > 0 do
        WriteProfileString( cs1, cs2, #0);
      WriteProfileString( cs1, cs2, pchar( s2 ));
      case Win32Platform of
       VER_PLATFORM_WIN32_NT :
         SendMessage( HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(cs1));
       VER_PLATFORM_WIN32_WINDOWS :
         SendMessage( HWND_BROADCAST, WM_SETTINGCHANGE, 0, LongInt(cs1));
     end; 
  Result := True;
end;
finally
  FreeMem( dum1 );
end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  GetPrinterNames;
  Listbox1.Items.AddStrings(PrinterNames);
end;
 
end.

[Andnotor]

Une autre possibilité ici.

Le composant TFilePrinterSetup dérive de TPrinterSetupDialog et permet la sauvegarde des options complètes d'impression (imprimante, bac, papier, orientation, etc.)

Il suffit d'appeler une fois sa méthode Execute (par exemple depuis une page de configuration) pour créer un fichier de définition. Et ensuite un Load du fichier avant la tâche d'impression.

L'imprimante par défaut n'est pas modifiée !

[hlmhv]

Merci à tous deux!

Je m'en vais tester cela sans (trop) tarder..