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:

procedure TForm1.Button1Click(Sender: TObject);
 var zeichen:char;
     code: string;
     i,j, Breite, Hoehe :integer;
begin
  assignfile(bilddatei,'smiley.pbm');
  reset(Bilddatei);
  code:='';
  // Code für Format einlesen
  // Wird hier nicht überprüft
  for i:=1 to 2 do
  begin
    read(bilddatei,zeichen);
    code:=code+zeichen;
  end;

  //Rest der zeile verwerfen
   while Zeichen<> chr(13) do begin read(bilddatei, Zeichen) end;
  // lf verwerfen
  read(bilddatei, zeichen);

  //erstes Zeichen der zweiten Zeile lesen
  read(bilddatei, zeichen);

  //Kommentarzeilen verwerfen
  while Zeichen ='#' do
  begin

    while Zeichen<>chr(13) do begin i:=i+1; read(bilddatei,zeichen);end;
    read(bilddatei,zeichen);


  end;

  // Bildabmessungen einlesen
  code:='';

  read(bilddatei,zeichen);
 while not (zeichen=' ') do
  begin
    code:=code+zeichen;
    read(bilddatei,zeichen);
  end;
  breite:=strtoint(code);
  code:='';

  read(Bilddatei,zeichen);
  while ((ord(zeichen)>47) and (ord(zeichen)<58)) do
  begin
    code:=code+Zeichen;
    read(Bilddatei, zeichen);
  end;
  hoehe:=strtoint(code);
  While zeichen <> chr(13) do read(bilddatei, zeichen);
  read(bilddatei,zeichen);

  //Bilddatenlesen und auf das Formular zeichnen

   for i:= 1 to hoehe  do
   begin
     for j:=1 to breite do
       begin
         read(bilddatei,zeichen);

         if Zeichen = '1' then form1.Canvas.Pixels[j,i] := clblack {Punkt schwarz färben}
          else form1.Canvas.Pixels[j,i]:=clwhite {Punkt weiß färben};
         read(bilddatei,zeichen){Leerzeichen verwerfen};
       end;
       //restliche Zeile verwerfen, bis Zeilenvorschub einfach nur lesen
       While not (zeichen = chr(10)) do read(bilddatei, zeichen);
    end;