Charger une image dans un tableau de pixels

**nelbardi** · 14/04/2009, 17h53

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.

**tekthoninks** · 15/04/2009, 19h19

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:

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;

Ainsi qu'un pdf d'une Université française qui explique le traitement d'images avec un exemple en Pascal
Semestre2/API1/Cours8.pdf

et une petite explicasse sur les images :

monique/images.pdf

**tekthoninks** · 16/04/2009, 20h14

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.

**tekthoninks** · 16/04/2009, 22h41

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

Charger une image dans un tableau de pixels

Turbo Pascal

Discussions similaires

Partager

Partager