Text aus Bild auslesen

[Elexarie]

Ich hänge gerade an einem ähnlichen Problem:

Folgender Quellcode:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtDlgs, ExtCtrls, unit2;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    Button2: TButton;
    Image1: TImage;
    Button3: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Button4: TButton;
    SavePictureDialog1: TSavePictureDialog;
    Button5: TButton;
    procedure Button2Click(Sender: TObject);
    function chartobin(buchstabe: char): string;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.chartobin(buchstabe: char): string;
var
  zahl: integer;
begin
  zahl := ord(buchstabe); // ordinaler Wert/ Ascii-wert
  repeat
    result := inttostr(zahl mod 2) + result;
    zahl := zahl div 2; // ermittlung des Binär-codes
  until zahl = 0;
  while (length(result) <= 7) do // Auffüllen mit 0 um 8 stellen zu füllen
    result := '0' + result;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  x, laenge: integer;
  eingabe, ausgabe, abbruchb: string;
begin
  eingabe := '';
  ausgabe := '';
  abbruchb := '01000000'; // abbruchbedingung wählen!!!!
  eingabe := Memo1.Text;
  x := 1;
  laenge := length(eingabe);
  showmessage(inttostr(laenge));
  repeat
    ausgabe := ausgabe + chartobin(eingabe[x]);
    inc(x);
  until (x = laenge);
  ausgabe := ausgabe + abbruchb; // anhängen der abbruchbedingung (oben gewählt)
  while ((length(ausgabe) mod 3) <> 0) do
    ausgabe := ausgabe + '0';
  Memo2.Clear;
  Memo2.Text := ausgabe;
end;

procedure TForm1.Button3Click(Sender: TObject); // Bild laden
begin
  if OpenPictureDialog1.execute then
    Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  Text: string;
  ix, iy, xende, yende, R, G, B: integer;
  farbe: TColor;
begin
  if Memo2.Text = '' then
    showmessage('Text umwandeln!')
  else
  begin
    xende := Image1.Picture.Width - 1;
    yende := Image1.Picture.Height - 1;
    Text := Memo2.Text;
    for iy := 0 to yende do
      for ix := 0 to xende do
      begin
        if Text <> '' then
        begin
          farbe := colortorgb(Image1.Canvas.Pixels[ix, iy]);
          // auslesen der Farbwerte
          R := getRvalue(farbe);
          G := getGvalue(farbe);
          B := getBvalue(farbe);
          R := R shr 1 shl 1; // letztes bit auf null setzen
          R := R + strtoint(Text[1]); // letztes bit mit erstem wert aus bincode (text) besetzen
          G := G shr 1 shl 1;
          G := G + strtoint(Text[2]);
          B := B shr 1 shl 1;
          B := B + strtoint(Text[3]);
          delete(Text, 1, 3);
        end
        else
        begin
          if SavePictureDialog1.execute then
            Image1.Picture.SaveToFile(SavePictureDialog1.FileName);
          showmessage('Der Text wurde versteckt und gespeichert!');
          exit; // rausspringen aus der for-verschachtelung -> bintext ist beendet
        end;
      end;
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  form2.ShowModal;
end;

end.

Delphi-Quellcode:

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtDlgs, ExtCtrls;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Button2: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Button3: TButton;
    Memo1: TMemo;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    function bytetochar (zeichen:string):string;
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form2: TForm2;

implementation

uses unit1;
{$R *.dfm}

function Tform2.bytetochar(zeichen: string):string;
var
  wert: integer;
begin
  wert := 0;
  wert := ((strtoint(zeichen[1]) * 128) + (strtoint(zeichen[2]) * 64) +
      (strtoint(zeichen[3]) * 32) + (strtoint(zeichen[4]) * 16) +
      (strtoint(zeichen[5]) * 8) + (strtoint(zeichen[6]) * 4) +
      (strtoint(zeichen[7]) * 2) + (strtoint(zeichen[8]) * 1));
  result := chr(wert);
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  Form2.Close;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  if OpenPictureDialog1.execute then
    Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;

procedure TForm2.Button3Click(Sender: TObject);
var
  xende, yende, ix, iy, R, G, B: integer;
  farbe: TColor;
  binary, ausgabe, zeichen, abbruchb: string;
begin
  abbruchb:='01000000'; //<- Übernehmen als schlüssel aus unit 1
  xende := Image1.Picture.Width - 1;
  yende := Image1.Picture.Height - 1;
  for iy := 0 to yende do
    for ix := 0 to xende do
    begin
      farbe := colortorgb(Image1.Canvas.Pixels[ix, iy]);
      R := getRvalue(farbe);
      G := getGvalue(farbe);
      B := getBValue(farbe);
      binary := binary + inttostr(R and 1);
      binary := binary + inttostr(G and 1);
      binary := binary + inttostr(B and 1);
      if length(binary) > 7 then
      begin
        zeichen := copy(binary, 1, 8);       //übernahme des erstellten binärcodes
        if zeichen = abbruchb then
        begin
          Memo1.Lines.Add(ausgabe);        //ausgabe der zeichenkette
          exit;                            //herausspringen aus verkettung -> text beendet bild aber noch nicht??
        end;
        ausgabe := ausgabe + bytetochar(zeichen);   //erstellung der zeichenkette über die function
        delete(binary, 1, 8);
        //leeren der hilfvariable binary
      end;
    end;
end;

end.

Ich bekomme beim Ende eine Endlosschleife. Ich bin mir recht sicher, dass es mit der Abbruchbedingung zusammenhängt.
Bitte schaut es euch an.