unit u15R31f;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

type
  { TFBildkodierer }

  TFBildkodierer = class(TForm)
    BAnzeige: TButton;
    BUmwandeln: TButton;
    EZahlen: TEdit;
    LZahlencode: TLabel;
    LBild: TLabel;
    LTitel: TLabel;
    MZahlen: TMemo;
    MBild: TMemo;
    procedure BAnzeigeClick(Sender: TObject);
    procedure BUmwandelnClick(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end; 

var
  FBildkodierer: TFBildkodierer;

implementation

{$R *.lfm}

{ TFBildkodierer }

function erstezahl(var s:string):integer;
var z:string;
begin
  z:='';
  while (length(s)>0) and (s[1]=' ') do delete(s,1,1);    // Leerzeichen löschen
  while (s<>'') and (s[1]<>' ') do begin                     // Ziffern auslesen
    z:=z+s[1];
    delete(s,1,1)
  end;
  while (length(s)>0) and (s[1]=' ') do delete(s,1,1);    // Leerzeichen löschen
  result:=strtoint(z)                       // in Zahl umwandeln und zurückgeben
end;

procedure TFBildkodierer.BAnzeigeClick(Sender: TObject);
var z,s,anz:integer;
    zf1,zf2:string;
    farbe:string;
begin
  MBild.Lines.Clear;
  for z:=1 to MZahlen.Lines.Count do begin
    zf1:=MZahlen.Lines[z-1];
    zf2:='';
    s:=1;
    farbe:=' ';                                 // die erste Zahl ist immer weiß
    while zf1<>'' do begin                         // die ganze Zeile abarbeiten
      anz:=erstezahl(zf1);                    // Anzahl Pixel mit gleicher Farbe
      for s:=1 to anz do zf2:=zf2+farbe;
      if farbe=' ' then farbe:='█'                             // Farbe wechseln
      else farbe:=' ';
    end;
    MBild.Lines.Add(zf2);                               // Bild in Memo anzeigen
  end;
end;

procedure TFBildkodierer.BUmwandelnClick(Sender: TObject);
var anz,b,breite:integer;
    zf1,zf2:string;
begin
  zf1:=EZahlen.Text;
  breite:=erstezahl(zf1);
  MZahlen.Lines.Clear;
  zf2:='';                                   // erste Zeile für Memo vorbereiten
  b:=0;
  while zf1<>'' do begin
    anz:=erstezahl(zf1);                      // Anzahl Pixel mit gleicher Farbe
    zf2:=zf2+inttostr(anz)+' ';                            // Memozeile aufbauen
    b:=b+anz;                                               // Bildbreite zählen
    if b>breite then begin
                                 // hier Fehlerbehandlung möglich: Zeile zu lang
      MZahlen.Lines.Add(zf2);
      zf2:='';                                  // nächste Memozeile vorbereiten
      b:=0
    end;
    if b=breite then begin                                // eine Bildzeile voll
      MZahlen.Lines.Add(zf2);
      zf2:='';                                  // nächste Memozeile vorbereiten
      b:=0
    end
  end;
end;

end.

