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
| XIncludeFile "..\..\gdiplus.pbi"
EnableExplicit
#MainWindow = 0
#ButtonGadget = 0
#Police = 0
Define .i
Global *token, *image1, *image2, *image3, *image4
Global Params.EncoderParameters, erreur, texte$, size.q, quit, Valeurparametre, OldProc
Global encoderCLSID.GUID, rc.rect, rc1.rect, NomFichier$, FichierParDefaut$, status
Procedure RatioLargeurHauteur(*ImageID)
; retourne le ratio à utiliser pour définir une image de 100 pixels de large
; retrouve les dimensions de l'image
Protected width.f, height.f, ratio_H.f, ratio_V.f
GdipGetImageDimension(*ImageID, @width, @height)
; calcul du meilleur ratio par rapport à un carré de 200x200
ratio_H = width/150
ratio_V = height/150
If ratio_H>ratio_V
rc\right = Round(width/ratio_H, 1)
rc\bottom = Round(height/ratio_H, 1)
Else
rc\right = Round(width/ratio_V, 1)
rc\bottom = Round(height/ratio_V, 1)
EndIf
EndProcedure
Procedure GDIpCallback(window, message, wParam, lParam)
Protected dc, ps.PAINTSTRUCT
Protected *Localtoken, *Localgfx
Protected color = ARGB(#White)
Select message
Case #WM_CLOSE
If *token
Gdiplus_DelImage(*image1)
Gdiplus_DelImage(*image2)
Gdiplus_DelImage(*image3)
Gdiplus_DelImage(*image4)
Gdiplus_Del(*token)
EndIf
OldProc = SetWindowLong_(WindowID(#MainWindow), #GWL_WNDPROC, OldProc)
quit + 1
ProcedureReturn 0
Case #WM_PAINT
dc = BeginPaint_(window, @ps)
If dc
; initialisation de Gdi+
*Localtoken = Gdiplus_New()
; on vérifie que l'initialisation est Ok
If *Localtoken
; création du graphique depuis la fenêtre
If GdipCreateFromHDC(dc, @*Localgfx) = #Ok
GdipSetPageUnit(*Localgfx, #unitPixel)
; affiche une réduction de chaque image
If *image1
RatioLargeurHauteur(*image1)
GdipDrawImageRectI(*Localgfx, *Image1, 10, 10, rc\right, rc\bottom)
rc1\right = rc\right
EndIf
If *image2
RatioLargeurHauteur(*image2)
GdipDrawImageRectI(*Localgfx, *Image2, rc1\right + 20, 10, rc\right, rc\bottom)
rc1\right + rc\right
EndIf
If *image3
RatioLargeurHauteur(*image3)
GdipDrawImageRectI(*Localgfx, *Image3, rc1\right + 30, 10, rc\right, rc\bottom)
rc1\right + rc\right
EndIf
If *image4
RatioLargeurHauteur(*image4)
GdipDrawImageRectI(*Localgfx, *Image4, rc1\right + 40, 10, rc\right, rc\bottom)
EndIf
Gdiplus_DelGraphics(*Localgfx)
EndIf
Gdiplus_Del(*Localtoken)
EndIf
EndPaint_(window, @ps)
EndIf
ProcedureReturn 0
EndSelect
ProcedureReturn CallWindowProc_(OldProc, window, message, wParam, lParam)
EndProcedure
If OpenWindow(#MainWindow, 0, 0, 650, 220, "GdiPlus 1.0 - GdipSaveAddImage", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ButtonGadget(#ButtonGadget, 10, 140, 630, 70, "Enregistrer les 4 images ci-dessus" + Chr(10) + "en un seul fichier au format tif", #PB_Button_MultiLine)
LoadFont(#Police, "Arial", 12)
SetGadgetFontEx(#ButtonGadget, #Police)
OldProc = SetWindowLong_(WindowID(#MainWindow), #GWL_WNDPROC, @GDIpCallback())
*token = Gdiplus_New()
If *token
; retrouve le CLSID of de l'encodeur TIFF
If GetEncoderClsid(#Tif_Encoder, @encoderCLSID) = -1
; impossible de retrouver le CLSID de l'encoder tiff
MessageRequester("Erreur", "Impossible de retrouver l'identifiant de l'encodeur" + Chr(10) + "l'application va fermer", 16)
Else
; création des 4 images qui serviront à créer la séquence d'images pour le tiff
GdipLoadimageFromFile("..\images\chien.bmp", @*image1)
GdipLoadimageFromFile("..\images\chat.png", @*image2)
GdipLoadimageFromFile("..\images\Rose_1.jpg", @*image3)
GdipLoadimageFromFile("..\images\chien_2.gif", @*image4)
If *image1 And *image2 And *image3 And *image4
; création du tableau d'encoder
; un EncoderParameters object est un tableau d'EncoderParameter.
; Initialise le seul élément du tableau pour cet exemple
Params\Count = 1
CopyMemory(?EncoderSaveFlag, Params\Parameter\guid, SizeOf(guid))
With Params\Parameter[0]
\NumberOfValues = 1
\Type = #EncoderparameterValueTypeLong
\Value = @Valeurparametre
EndWith
Else
Gdiplus_DelImage(*image1)
Gdiplus_DelImage(*image2)
Gdiplus_DelImage(*image3)
Gdiplus_DelImage(*image4)
Gdiplus_Del(*token)
quit + 1
EndIf
; boucle
Repeat
If quit = 0
Select WaitWindowEvent()
Case #PB_Event_Gadget
erreur = 0
; ouvre la boite d'enregistrement des fichiers
NomFichier$ = SaveFileRequester("Enregistrer le fichier tif", "..\images\", "Tiff (*.tif)|*.tif", 0)
If NomFichier$ = ""
erreur = 1
ElseIf GetExtensionPart(NomFichier$) = ""
If Right(NomFichier$, 1) = "."
NomFichier$ = Left(NomFichier$, Len(NomFichier$)-1)
EndIf
NomFichier$ = GetPathPart(NomFichier$) + GetFilePart(NomFichier$) + ".tif"
ElseIf LCase(GetExtensionPart(NomFichier$))<>"tif"
MessageRequester("Erreur", "L'extension du fichier n'est pas 'tif'", 16)
erreur = 1
EndIf
If CheckFilename(GetFilePart(NomFichier$)) = 0
erreur = 1
EndIf
size = FileSize(NomFichier$)
If (erreur = 0) And (size> -1)
texte$ = "Le fichier " + GetFilePart(NomFichier$) + " existe" + Chr(10) + Chr(10)
texte$ + "Voulez-vous l'écraser ?"
If MessageRequester("Fichier existant", texte$, #PB_MessageRequester_YesNoCancel)<>#PB_MessageRequester_Yes
erreur = 1
EndIf
EndIf
If erreur = 0
; Sauvegarde la première page
Valeurparametre = #EncoderValueMultiFrame
status = GdipSaveImageToFile(*Image1, NomFichier$, @encoderCLSID, @Params)
If status = #Ok
; la première page a été sauvegardée correctement, on sauvegarde la seconde page
Valeurparametre = #EncoderValueFrameDimensionPage
status = GdipSaveAddImage(*Image1, *Image2, Params)
If status = #Ok
; la seconde page a été sauvegardée correctement, on sauvegarde la troisième page
Valeurparametre = #EncoderValueFrameDimensionPage
status = GdipSaveAddImage(*Image1, *Image3, Params)
If status = #Ok
; la troisième page a été sauvegardée correctement, on sauvegarde la quatrième page
Valeurparametre = #EncoderValueFrameDimensionPage
status = GdipSaveAddImage(*Image1, *Image4, Params)
If status = #Ok
; la quatrième page a été sauvegardée correctement, ferme le fichier (séquence d'image)
Valeurparametre = #EncoderValueFlush
status = GdipSaveAdd(*Image1, @Params)
If status = #Ok
size = FileSize(NomFichier$)
texte$ = "Le fichier " + GetFilePart(NomFichier$) + Chr(10) + "a été enregistré avec succès" + Chr(10) + Chr(10)
texte$ + "Taille du fichier : " + Str(size) + " octets (" + Str(size/1024) + " Ko)"
MessageRequester("Enregistrement du fichier tif", texte$)
Else
MessageRequester("Erreur", "La fonction GdipSaveAdd a échouée" + Chr(10) + " et a retournée l'erreur " + Str(status), 16)
EndIf
Else
MessageRequester("Erreur", "La fonction GdipSaveAddImage a échouée (4ième image)" + Chr(10) + " et a retournée l'erreur " + Str(status), 16)
EndIf
Else
MessageRequester("Erreur", "La fonction GdipSaveAddImage a échouée (3ième image)" + Chr(10) + " et a retournée l'erreur " + Str(status), 16)
EndIf
Else
MessageRequester("Erreur", "La fonction GdipSaveAddImage a échouée (2ième image)" + Chr(10) + " et a retournée l'erreur " + Str(status), 16)
EndIf
Else
MessageRequester("Erreur", "La fonction GdipSaveImageToFile a échouée" + Chr(10) + " et a retournée l'erreur " + Str(status), 16)
EndIf
EndIf
EndSelect
EndIf
Until quit
EndIf
EndIf
EndIf
End |
02/02/2012, 11h55
Informations sur de la documentation
00
