Bonjour tout le monde,
je galére depuis 2 jours, j'essaye de faire un programme qui charge une image dans un tableau de pixels, mais en Pascal. Merci de me donner des tuyaux.
Bonjour tout le monde,
je galére depuis 2 jours, j'essaye de faire un programme qui charge une image dans un tableau de pixels, mais en Pascal. Merci de me donner des tuyaux.
J'essaie de t'aider :
Donc j'ai trouvé une source qui charge un fichier .BMP de 64000 bytes
où tu pourrais essayer de t'aider:
Ainsi qu'un pdf d'une Université française qui explique le traitement d'images avec un exemple en Pascal
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 type TBitmap = record Width, Height: word; Bitmap: array[0..63999] of byte; end; const HeaderID = 'PBM64'; function LoadFromFile(const filename: string): TBitmap; var f: file; FileHeader: string; BM: TBitmap; begin Assign(f, filename); Reset(f, 1); BM.Width := 0; BM.Height := 0; if FileSize(f) <> SizeOf(TBitmap)+5 then begin FileHeader := ' '; BlockRead(f, FileHeader[1], 5); if FileHeader = HeaderID then BlockRead(f, BM, SizeOf(TBitmap)); end; Close(f); LoadFromFile := BM; end; procedure SaveToFile(const filename: string; Bitmap: TBitmap); var f: file; begin Assign(f, filename); Rewrite(f, 1); BlockWrite(f, HeaderID[1], 5); BlockWrite(f, BM, SizeOf(TBitmap)); Close(f); end; procedure DrawBitmap(X0, Y0: integer; Bitmap: TBitmap); var x, y: integer; begin with Bitmap do for y := 0 to Height-1 do for x := 0 to Width-1 do SetPixel(X0+x, Y0+y, Bitmap[x+y*Width]); end;
Semestre2/API1/Cours8.pdf
et une petite explicasse sur les images :
monique/images.pdf
Effectivement Nelbardi,
C'est une galère de travailler des images en Pascal Standard
J'ai essayé de travailler sur ce point et voici une source qui n'est pas terminée mais si ça peut aider ...
Je n'arrivais pas à récupérer les hauteurs et largeurs (en lisant les caractères numéraux de la troisième ligne de chaque fichier image PGM) alors il n'y a que Obama pour le moment (Il y avait Sarkozy et Ahmadinejad).
Pascal source pour images.zip
Code images.pas : 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
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 program images; {$MODE DELPHI} uses sysutils; type COULEUR = String[255]; IMAGE = record largeur, hauteur : 1..1024; pixels : array[1..1024, 1..1024] of COULEUR; end; {/Drocer} var KeyNum : Cardinal; CheminAbsolu : String; Chemin : String; k : Integer; OsNum : Cardinal; Fichier : Text; Fichier2 : Text; Ligne : String; img : IMAGE; r : Integer; (********************************************************************** Procedure Advertissing **********************************************************************) procedure Advertissing; begin writeln('Indiquez le numero de l''image pgm a ouvrir'); writeln('L''image se trouve dans le repertoire du programme'); writeln('[1] : OBAMA'); (*writeln('[2] : SARKOZY'); writeln('[3] : AHMADINEJAD');*) end; (********************************************************************** Fin de la Procedure Advertissing **********************************************************************) (********************************************************************** Procedure Advertissing2 **********************************************************************) procedure Advertissing2; begin writeln('Quel est votre systeme d''exploitation?'); writeln('[0] : Linux, Unix, BSD ou Mac'); writeln('[1] : Microsoft Windows ou MS-DOS'); end; (********************************************************************** Fin de la Procedure Advertissing2 **********************************************************************) (********************************************************************** Fonction EstQui **********************************************************************) function EstQui (const num : Cardinal):string; begin if num = 1 then result := 'obama.pgm' (*else if num = 2 then result := 'sarkozy.pgm' else if num = 3 then result := 'ahmadinejad.pgm' else result := '' {/Fi} {/Fi}*) {/Fi} end; (********************************************************************** Fin de la Fonction EstQui **********************************************************************) (********************************************************************** Fonction OS **********************************************************************) function OS (num : cardinal): boolean; begin result := false; if num = 0 then result := true //Unix else if num = 1 then result := false //Windows {/Fi} {/fi} end; (********************************************************************** Fin de la Fonction OS **********************************************************************) (********************************************************************** PROGRAMME PRINCIPAL - PROGRAMME PRINCIPAL - PROGRAMME PRINCIPAL **********************************************************************) begin advertissing(); // procedure explicative readln(KeyNum); while (KeyNum <> 1) do begin advertissing(); readln(KeyNum); end; {/Elihw} CheminAbsolu := ParamStr(0); // Chemin absolu de ce programme. k := length(CheminAbsolu); advertissing2(); readln(OsNum); while (OsNum > 1) or (OsNum < 0) do begin advertissing2(); readln(OsNum); end; {/Elihw} if Os(OsNum) then begin while (CheminAbsolu[k] <> '/') do // Tant que nous ne trouvons pas une slash Unix BSD begin dec(k); end; {/Elihw} end else if Not Os(OsNum) then begin while (CheminAbsolu[k]) <> '\' do // Tant que nous ne trouvons pas une backslash Windows begin dec(k); end; {/Elihw} end; {/Fi} {/Fi} delete(CheminAbsolu,k+1,(length(CheminAbsolu)-k)); Chemin := CheminAbsolu + EstQui(KeyNum); Assign(Fichier,Chemin); reset(Fichier); (** Test existence du fichier **) If IOresult <> 0 then // Si l'output répond pas trouver fichier, alors begin writeln('L''image est inexistante dans le repertoire courant du programme'); writeln(CheminAbsolu); halt; end {/Fi} (** Fin de Test d'existence du Fichier **) else begin while not eof(Fichier) do begin readln(Fichier,Ligne); readln(Fichier,Ligne); readln(Fichier,Ligne); readln(Fichier,Ligne); for k := 1 to 670 do begin for r := 1 to 460 do begin readln(Fichier,Ligne); img.pixels[k,r] := Ligne; end; {/Rof} end; {/Rof} end; {/Elihw} end; {/fi} Assign(Fichier2,CheminAbsolu+'Test.pgm'); rewrite(Fichier2); writeln(Fichier2,'P2 '); writeln(Fichier2,'# Developper, ça fouette un max'); writeln(Fichier2,670,' ',460); writeln(Fichier2,high(COULEUR)); for k := 1 to 670 do begin for r := 1 to 460 do begin Ligne := img.pixels[k,r]; writeln(Fichier2,Ligne); end; {/Rof} end; {/Rof} close (Fichier2); close(Fichier); writeln('Le fichier recree se nomme ',CheminAbsolu+'Test.pgm'); end.
Voila, on peut traiter avec Obama, Sarkozy et Ahmadinejad.
Il y a une procedure qui lit les hauteurs et largeurs de ces personnages (je voulais pas faire dans le vulgaire avec les gros bonnets ou les grosses pointures )
Il y a une optimisatisation de la recherche par système d'exploitation.
(qqun sous Linux croit peut-être qu'il travaille dans un environnement Vista et vice-versa).
Code imageOK.pas : 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
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
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290 program images; {$MODE DELPHI} uses sysutils; type COULEUR = String[255]; IMAGE = record largeur, hauteur : 1..1024; pixels : array[1..1024, 1..1024] of COULEUR; end; {/Drocer} var KeyNum : Cardinal; CheminAbsolu : String; Chemin : String; bat : string; k : Integer; OsNum : Cardinal; Fichier : Text; Fichier2 : Text; Ligne : String; img : IMAGE; r : Integer; (********************************************************************** Procedure Advertissing **********************************************************************) procedure Advertissing; begin writeln('Indiquez le numero de l''image pgm a ouvrir'); writeln('L''image se trouve dans le repertoire du programme'); writeln('[1] : OBAMA'); writeln('[2] : SARKOZY'); writeln('[3] : AHMADINEJAD'); end; (********************************************************************** Fin de la Procedure Advertissing **********************************************************************) (********************************************************************** Procedure Advertissing2 **********************************************************************) procedure Advertissing2; begin writeln('Quel est votre systeme d''exploitation?'); writeln('[0] : Linux, Unix, BSD ou Mac'); writeln('[1] : Microsoft Windows ou MS-DOS'); end; (********************************************************************** Fin de la Procedure Advertissing2 **********************************************************************) (********************************************************************** Procedure Batard **********************************************************************) procedure batard (out bat : string); begin bat :=''; writeln('Donnez le nom du fichier (sans extension) pour la sauvegarde'); writeln('Exemple : papa, fichier, essai, first'); readln(bat); bat := bat+'.pgm'; end; (********************************************************************** Fin de la Procedure Batard **********************************************************************) (********************************************************************** Procedure HauteurLargeur **********************************************************************) procedure HauteurLargeur (out ligne : string ; const chemin : string); type st = array [1..2] of string; var strol : st; str : string; Fichier : Text; k, r, s : Integer; cara : Char; begin r := 1; str := ''; Assign(Fichier,chemin); reset(Fichier); while not eoln(Fichier) do begin readln(Fichier,Ligne); readln(Fichier,Ligne); readln(Fichier,Ligne); for k := 1 to Length(Ligne) do begin if Ligne[k] <> #32 then begin cara := Ligne[k]; str := str + cara; end else begin strol[r] := str; //writeln(str); writeln(strol[r]); str := ''; img.hauteur := StrToInt(strol[r]); inc(r); end; end; {/Rof} str := ''; for s := length(ligne) downto 1 do begin if Ligne[s] <> #32 then begin cara := Ligne[s]; str := cara + str; end else begin strol[r] := str; writeln(strol[r]); str := ''; img.largeur := StrToInt(strol[r]); end; {/Fi} end; {/Rof} end; {/Elihw} end; // Fin de la procedure (********************************************************************** Fin de Procedure HauteurLargeur **********************************************************************) (********************************************************************** Fonction EstQui **********************************************************************) function EstQui (const num : Cardinal):string; begin if num = 1 then result := 'obama.pgm' else if num = 2 then result := 'sarkozy.pgm' else if num = 3 then result := 'ahmadinejad.pgm' else result := '' {/Fi} {/Fi} {/Fi} end; (********************************************************************** Fin de la Fonction EstQui **********************************************************************) (********************************************************************** Fonction OS **********************************************************************) function OS (num : cardinal): boolean; begin result := false; if num = 0 then result := true //Unix else if num = 1 then result := false //Windows {/Fi} {/fi} end; (********************************************************************** Fin de la Fonction OS **********************************************************************) (********************************************************************** PROGRAMME PRINCIPAL - PROGRAMME PRINCIPAL - PROGRAMME PRINCIPAL **********************************************************************) begin advertissing(); // procedure explicative readln(KeyNum); while (KeyNum < 1) or (KeyNum >3) do begin advertissing(); readln(KeyNum); end; {/Elihw} CheminAbsolu := ParamStr(0); // Chemin absolu de ce programme. k := length(CheminAbsolu); advertissing2(); readln(OsNum); while (OsNum > 1) or (OsNum < 0) do begin advertissing2(); readln(OsNum); end; {/Elihw} if Os(OsNum) then begin while (CheminAbsolu[k] <> '/') do // Tant que nous ne trouvons pas une slash Unix BSD begin dec(k); if k = 1 then begin writeln('Ceci est un faux chemin Unix :: STOP'); // Fausse piste c'est du Windows halt; end; {/Fi} end; {/Elihw} end else if Not Os(OsNum) then begin while (CheminAbsolu[k] <> '\') do // Tant que nous ne trouvons pas une backslash Windows begin dec(k); if k = 1 then begin writeln('Ceci est un faux chemin Windows :: STOP'); // Fausse Piste c'est du Unix halt; end; {/Fi} end; {/Elihw} end; {/Fi} {/Fi} (** Test existence du fichier **) If IOresult <> 0 then // Si l'output répond pas trouver fichier, alors begin writeln('L''image est inexistante dans le repertoire courant du programme'); writeln(CheminAbsolu); halt; end (** Fin de Test d'existence du Fichier **) else begin Batard(bat); delete(CheminAbsolu,k+1,(length(CheminAbsolu)-k)); Chemin := CheminAbsolu + EstQui(KeyNum); Assign(Fichier,Chemin); reset(Fichier); while not eof(Fichier) do begin readln(Fichier,Ligne); readln(Fichier,Ligne); readln(Fichier,Ligne); HauteurLargeur(Ligne,Chemin); readln(Fichier,Ligne); for k := 1 to img.hauteur do begin for r := 1 to img.largeur do begin readln(Fichier,Ligne); img.pixels[k,r] := Ligne; end; {/Rof} end; {/Rof} end; {/Elihw} end; {/fi} Assign(Fichier2,CheminAbsolu+bat); rewrite(Fichier2); writeln(Fichier2,'P2 '); writeln(Fichier2,'# developper me fait mal au Q i'); writeln(Fichier2,img.hauteur,' ',img.largeur); writeln(Fichier2,high(COULEUR)); for k := 1 to img.hauteur do begin for r := 1 to img.largeur do begin Ligne := img.pixels[k,r]; writeln(Fichier2,Ligne); end; {/Rof} end; {/Rof} close (Fichier2); close(Fichier); writeln('Le fichier recree se nomme ',CheminAbsolu+bat); end.
Le zip est changé lui aussi
Source et images.zip
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager