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 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232
|
Program IMPRIME;
(* Démonstration d'impression en mode graphique utilisant les fonctions GDI *)
(* ---------------------------------------------------------------------------------------------------------------------- *)
(* Directives de compilation *)
(* ---------------------------------------------------------------------------------------------------------------------- *)
{$B-,D+,H-,I-,J+,P-,Q-,R-,S-,T-,V+,W-,X+,Z-}
{&AlignCode+,AlignData+,AlignRec+,Asm-,Cdecl-,Comments-,Delphi+,Frame+,G5+}
{&LocInfo+,Open32-,Optimise+,OrgName-,SmartLink+,Speed+,Use32+,ZD-}
{$M 32768}
Uses Strings, (* Chaînes AZT *)
Windows, (* API Win32 *)
Objects, (* Objets génériques *)
OWindows, (* Objets fenêtres OWL *)
CommDlg; (* Dialogues standard Win32 *)
Const NomApplication = 'Test d''impression';
(* ---------------------------------------------------------------------------------------------------------------------- *)
(* Déclarations de types *)
(* ---------------------------------------------------------------------------------------------------------------------- *)
Type (* ========= Session d'impression ========== *)
pImpression = ^tImpression;
tImpression = Object(tObject)
DC : hDC; (* Contexte de périphérique d'impression *)
ParametresImpression : tPrintDlg;
Constructor INIT;
(* Dialogue de choix d'imprimante et création du contexte de périphérique d'impression *)
Function IMPRIMER (hWindow : hWnd) : LongBool;
(* Impression d'un rectangle *)
Destructor DONE; virtual;
(* Destruction du contexte de périphérique d'impression *)
end;
(* ========== Fenêtre principale ========== *)
pFenetrePrincipale = ^tFenetrePrincipale;
tFenetrePrincipale = Object(tWindow)
Procedure SETUPWINDOW;
virtual;
(* Message d'accueil *)
Procedure WMLBUTTONDOWN (var Msg : tMessage);
virtual wm_First + wm_LButtonDown;
(* Clic gauche : impression d'un rectangle *)
end;
(* ========== Programme principal ========== *)
tProgramme = Object(tApplication)
Procedure INITMAINWINDOW;
virtual;
(* Chargement de la fenêtre principale *)
end;
(* ---------------------------------------------------------------------------------------------------------------------- *)
(* Variables globales *)
(* ---------------------------------------------------------------------------------------------------------------------- *)
Var (* ========== Programme principal ========== *)
Programme : tProgramme;
(* ---------------------------------------------------------------------------------------------------------------------- *)
(* Méthodes de l'objet tImpression *)
(* ---------------------------------------------------------------------------------------------------------------------- *)
Constructor tImpression.INIT;
(* Dialogue de choix d'imprimante et création du contexte de périphérique d'impression *)
Begin
tObject.INIT;
FillChar(ParametresImpression,SizeOf(ParametresImpression),0);
ParametresImpression.lStructSize := SizeOf(tPrintDlg);
ParametresImpression.Flags := pd_HidePrintToFile or pd_ReturnDC;
if PrintDlg(ParametresImpression)
then
DC := ParametresImpression.hDC;
End;
Function tImpression.IMPRIMER (hWindow : hWnd) : LongBool;
(* Impression d'un rectangle.
- Paramtre : hWindow = handle de la fenêtre parent;
- Sortie : True si tout s'est bien passé, False si erreur. *)
Var AncienCurseur : hCursor; (* Ancien curseur *)
DI : tDocInfo; (* Structure passée à la fonction StartDoc *)
NomDoc : Array [0..31] of Char; (* Nom de la session d'impression *)
n : DWord; (* Compteur de copies *)
Erreur : LongInt; (* Résultat des fonctions d'impression *)
AncienCrayon, Crayon : hPen; (* Ancien et nouveau crayon *)
AncienPinceau, Pinceau : hBrush; (* Ancien et nouveau pinceau *)
Titre : Array [0..39] of Char; (* Titre de la boîte à messages *)
Texte : Array [0..255] of Char; (* Texte de la boîte à messages *)
Begin
IMPRIMER := True;
if DC <> 0
then
begin
Erreur := 0;
n := 1;
while (Erreur = 0) and (n <= ParametresImpression.nCopies) do
begin
AncienCurseur := SetCursor(LoadCursor(0,idc_Wait));
(* Structure de démarrage de la session d'impression *)
FillChar(DI,SizeOf(DI),0);
DI.cbSize := SizeOf(tDocInfo);
StrCopy(NomDoc,NomApplication);
DI.lpszDocName := NomDoc;
DI.lpszOutput := Nil;
(* Début de la session d'impression *)
if (StartDoc(DC,DI) > 0) and (StartPage(DC) > 0)
then
begin
(* Création des outils de dessin *)
Crayon := CreatePen(ps_Solid,0,RGB(255,0,0)); (* Crayon rouge pour le contour *)
AncienCrayon := SelectObject(DC,Crayon);
Pinceau := CreateSolidBrush(RGB(0,255,0)); (* Pinceau vert pour l'intérieur *)
AncienPinceau := SelectObject(DC,Pinceau);
(* Dessin du rectangle *)
Rectangle(DC,10,10,200,100);
(* Destruction des outils de dessin *)
SelectObject(DC,AncienCrayon);
DeleteObject(Crayon);
SelectObject(DC,AncienPinceau);
DeleteObject(Pinceau);
(* Impression de la page *)
Erreur := EndPage(DC);
if Erreur >= 0
then (* Pas d'erreur si la valeur renvoyée est > 0 *)
begin
Erreur := 0;
EndDoc(DC);
end
else (* Erreur renvoyée par l'imprimante *)
begin
case Erreur of
sp_Error : StrCopy(Texte,'Erreur g'#233'n'#233'rale de l''imprimante');
sp_AppAbort,sp_UserAbort : StrCopy(Texte,'Impression stopp'#233'e');
sp_OutOfDisk : StrCopy(Texte,'Espace disque insuffisant pour l''impression d''arri'#232're-plan');
sp_OutOfMemory : StrCopy(Texte,'M'#233'moire insuffisante pour l''impression d''arri'#232're-plan');
end;
AbortDoc(DC);
StrCopy(Titre,'Erreur d''impression');
MessageBox(hWindow,Texte,Titre,mb_IconHand or mb_Ok);
IMPRIMER := False;
end;
end
else (* Erreur d'initialisation de l'imprimante *)
begin
AbortDoc(DC);
StrCopy(Texte,'Erreur d''initialisation de l''imprimante');
StrCopy(Titre,'Erreur d''impression');
MessageBox(hWindow,Texte,Titre,mb_IconHand or mb_Ok);
IMPRIMER := False;
end;
SetCursor(AncienCurseur);
Inc(n);
end;
end
else (* Erreur : contexte de périphérique non créé *)
begin
StrCopy(Texte,'Contexte de p'#233'riph'#233'rique non cr'#233#233' ou op'#233'ration annul'#233'e.');
StrCopy(Titre,'Erreur d''impression');
MessageBox(hWindow,Texte,Titre,mb_IconHand or mb_Ok);
IMPRIMER := False;
end;
End;
Destructor tImpression.DONE;
(* Destruction du contexte de périphérique d'impression *)
Begin
if DC <> 0
then
DeleteDC(DC);
tObject.DONE;
End;
(* ---------------------------------------------------------------------------------------------------------------------- *)
(* Méthodes de l'objet tFenetrePrincipale *)
(* ---------------------------------------------------------------------------------------------------------------------- *)
Procedure tFenetrePrincipale.SETUPWINDOW;
(* Affichage d'un message d'accueil *)
Begin
tWindow.SetupWindow;
MessageBox(hWindow,'Clic gauche = imprimer un rectangle','Bienvenue',mb_IconInformation or mb_Ok);
End;
Procedure tFenetrePrincipale.WMLBUTTONDOWN (var Msg : tMessage);
(* Clic gauche : impression d'un rectangle *)
Var Impression : pImpression; (* Session d'impression *)
Begin
Impression := New(pImpression,INIT);
if Impression <> Nil
then
begin
Impression^.IMPRIMER(hWindow);
Dispose(Impression,DONE);
end;
End;
(* ---------------------------------------------------------------------------------------------------------------------- *)
(* Méthodes de l'objet tProgramme *)
(* ---------------------------------------------------------------------------------------------------------------------- *)
Procedure tProgramme.INITMAINWINDOW;
(* Chargement de la fenêtre principale *)
Begin
MainWindow := New(pFenetrePrincipale,INIT(Nil,NomApplication));
End;
(* ---------------------------------------------------------------------------------------------------------------------- *)
(* PROGRAMME PRINCIPAL *)
(* ---------------------------------------------------------------------------------------------------------------------- *)
BEGIN
Programme.INIT(NomApplication);
Programme.RUN;
Programme.DONE;
END. |
Partager