Разрезать картинку на буквы

[grafgrial]

люди подскажите как мне вывести буквы поочередно в image (например P потом R следующая O и т.д.)
Безымянный.jpg
Я вкурсе что нужно читать по пиксилям с черным цветом, но не знаю как это написать

[mihali4]

Процесс называется "распознавание каптчи".
Вот по этому слову "каптча" (еще и по "капча" - многие пишут неграмотно ) и ищите на форуме и в инете.
Уже обсуждалось.

[grafgrial]

Нашел вот такой код, но он только выделяет первую строку и не могу сделать вывод каждой буквы в image

function TForm1.Parce1(Pic:TPicture;X: Integer): Boolean;
var
  i : Integer;
begin
  Result := False;
  with Pic do
    for i := 0 to Bitmap.Height - 1 do
      if Bitmap.Canvas.Pixels[x,i] = clBlack
        then
          begin
            Result := True;
            Break;
          end;
end;

function TForm1.Parce2(Pic:TPicture;Y, x1, x2: Integer): Boolean;
var
  i : Integer;
begin
  Result := False;
  with Pic do
    for i := x1 to x2 do
      if Bitmap.Canvas.Pixels[i,y] = clBlack
        then
          begin
            Result := True;
            Break;
          end;
end;

function TForm1.PreParse2(Pic:TPicture):TBitmap;
var
  i, q1, q2, j : Integer;
  md:Tbitmap;
begin
md:=TBitmap.create;
  q1 := 0;
  q2 := 0;
  with Pic do
    for i := 2 to Bitmap.Width - 3 do
      begin
        if (not Parce1(Pic,i - 2)) and (not Parce1(Pic,i - 1)) and Parce1(Pic,i) and Parce1(Pic,i + 1) then q1 := i;
        if Parce1(Pic,i - 1) and Parce1(Pic,i) and (not Parce1(Pic,i + 1)) and (not Parce1(Pic,i + 2))
          then
            for j := 2 to Bitmap.Height - 3 do
              begin
                if (not Parce2(Pic,j - 2,q1,i)) and (not Parce2(Pic,j - 1,q1,i)) and Parce2(Pic,j,q1,i) and Parce2(Pic,j + 1,q1,i) then q2 := j;
                if Parce2(Pic,j - 1,q1,i) and Parce2(Pic,j,q1,i) and (not Parce2(Pic,j + 1,q1,i)) and (not Parce2(Pic,j + 2,q1,i))
                  then begin

                    md.Assign(Parce3(Pic,q1,q2,i,j));
                    break;
                    end;
              end;
      end;
Result:=md;
end;

function TForm1.Parce3(Pic:TPicture;x1, y1, x2, y2: Integer): TBitmap;
var
 bmp : TBitmap;
begin
 with Pic.Bitmap do
 begin
  Canvas.Pen.Color := clRed;
  Canvas.MoveTo(x1-1, y1-1);
  Canvas.LineTo(x2+1, y1-1);
  Canvas.LineTo(x2+1, y2+1);
  Canvas.LineTo(x1-1, y2+1);
  Canvas.LineTo(x1-1, y1-1);
 end;
 bmp := TBitmap.Create;
 bmp.Height := 16;
 bmp.Width  := 16;
 StretchBlt(bmp.Canvas.Handle,0,0,16,16,Pic.Bitmap.Canvas.Handle,x1,y1,x2 - x1+1,y2 - y1+1,SRCCOPY);
 Result := bmp;
end;

[Prisioner]

Стало интересно. Делать было нечего. То, что получилось, выкладываю в архиве.

Уточнения, которые не очень ясно прокомментил в коде или не прокомментил вообще
1) Перед использованием картинку надо перевести в bmp (не реализовывал этого программно, просто в паинте переделал и загрузил в Image1 картинку в bitmap).

2) Назначаем "условно черный" цвет (так как по краям и в тонких местах букв цвет не черный, а серый).

Поиграв с точностью поиска для белого фона и конкретно данный картинки методом научного тыка был выбран rgb(150, 150, 150). rgb(100, 100, 100) не подходит. Стоит подбирать нечто между ними для большей точности.

Этот цвет присвоен переменной LikeBlack в коде

3) После формирования списка букв, посмотреть на неё в Image можно кликом/даблкликом по ней в листбоксе

P.S. Если что-то ещё не уточнил в комментариях в коде - могу ответить на возникший вопрос

P.P.S. Я знаю, что я наверняка что-то делаю коряво и наверняка что-то можно было сделать проще/быстрее. К конструктивной критике готов.

[jone]

Сообщение от Prisioner

Стало интересно. Делать было нечего. То, что получилось, выкладываю в архиве.

Уточнения, которые не очень ясно прокомментил в коде или не прокомментил вообще
1) Перед использованием картинку надо перевести в bmp (не реализовывал этого программно, просто в паинте переделал и загрузил в Image1 картинку в bitmap).

2) Назначаем "условно черный" цвет (так как по краям и в тонких местах букв цвет не черный, а серый).

Поиграв с точностью поиска для белого фона и конкретно данный картинки методом научного тыка был выбран rgb(150, 150, 150). rgb(100, 100, 100) не подходит. Стоит подбирать нечто между ними для большей точности.

Этот цвет присвоен переменной LikeBlack в коде

3) После формирования списка букв, посмотреть на неё в Image можно кликом/даблкликом по ней в листбоксе

P.S. Если что-то ещё не уточнил в комментариях в коде - могу ответить на возникший вопрос

P.P.S. Я знаю, что я наверняка что-то делаю коряво и наверняка что-то можно было сделать проще/быстрее. К конструктивной критике готов.

Мне очень понравилось как вы это зделали везде искал подобное ненашёл а тут прям подносом))

У меня буквы прыгают немного и поэтаму програма распознаёт не по порядку а немного в разброс по высате чтоли... , как этого избежать? чтобы по парядку как идут так и ситывал у меня одна строка