Распознавание изображения

[ClMlD]

Спасибо огромное полет почти нормальный , сделал скрин функцией первые цифры определило остальные фильтр не разобрал я думаю это из за фона , в архиве само полотно ( показать что имеется плавное изменение цвета но в целом он черный) и сделаный снимок который полностью не разобрался

P.S если можете дайте ссылку на материал по данной теме я помню как то в icq скидывали но я ее потерял

[BDA]

Я уже не помню, о каком материале речь.
Так работает:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Memo1: TMemo;
    Button3: TButton;
    Image2: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    function scrin(x, y, h, w: integer): integer;
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  bmp: tbitmap;

CONST
  PixelCountMax = 32768;

TYPE
  pRGBArray = ^TRGBArray;
  TRGBArray = ARRAY [0 .. PixelCountMax - 1] OF TRGBQuad; // TRGBTriple;

implementation

{$R *.dfm}

procedure solver(var sum: string; b, e: integer);
begin
  if e - b + 1 = 3 then
    sum := sum + '1'
  else if bmp.Canvas.Pixels[b + 1, 5] = clblack then
    sum := sum + '2'
  else if bmp.Canvas.Pixels[b + 2, 5] = clblack then
    sum := sum + '7'
  else if bmp.Canvas.Pixels[b + 3, 5] = clblack then
    sum := sum + '4'
  else if bmp.Canvas.Pixels[b, 0] = clblack then
    sum := sum + '5'
  else if bmp.Canvas.Pixels[b + 1, 1] = clblack then
    sum := sum + '6'
  else if (bmp.Canvas.Pixels[b + 4, 3] = clblack) and
    (bmp.Canvas.Pixels[b + 1, 4] = clblack) then
    sum := sum + '9'
  else if (bmp.Canvas.Pixels[b + 2, 3] = clblack) and
    (bmp.Canvas.Pixels[b + 1, 3] <> clblack) then
    sum := sum + '3'
  else if bmp.Canvas.Pixels[b, 3] = clblack then
    sum := sum + '0'
  else
    sum := sum + '8';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  x, y: integer;
  cif, cl: boolean;
  b, e: integer;
  sum: string;
begin
  Memo1.Clear;
  Memo1.Lines.BeginUpdate;
  sum := '';
  cif := false;
  b := 0;
  for x := 0 to bmp.Width - 1 do
  begin
    cl := true;
    for y := 0 to bmp.Height - 1 do
      if bmp.Canvas.Pixels[x, y] = clblack then
      begin
        if not cif then
        begin
          b := x;
          cif := true;
        end;
        cl := false;
        break;
      end;
    if cif and cl then
    begin
      e := x - 1;
      solver(sum, b, e);
      Memo1.Lines.Add(inttostr(b) + ' ' + inttostr(e) + ' = ' + inttostr
          (e - b + 1));
      cif := false;
    end;
  end;
  if cif then
  begin
    e := bmp.Width - 1;
    solver(sum, b, e);
    Memo1.Lines.Add(inttostr(b) + ' ' + inttostr(e));
  end;
  Label1.Caption := sum;
  Memo1.Lines.EndUpdate;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  x, y: integer;
  Row: pRGBArray;
begin
  for y := bmp.Height - 1 downto 0 do
  begin
    Row := pRGBArray(bmp.Scanline[y]);
    for x := 0 to bmp.Width - 1 do
    begin
      { if (Row[x].rgbtred < 30) and (Row[x].rgbtgreen < 30) and
        (Row[x].rgbtblue < 30) then
        begin
        Row[x].rgbtblue := 255;
        Row[x].rgbtgreen := 255;
        Row[x].rgbtred := 255;
        end
        else
        begin
        Row[x].rgbtblue := 0;
        Row[x].rgbtgreen := 0;
        Row[x].rgbtred := 0;
        end; }
      if (Row[x].rgbred < 30) and (Row[x].rgbgreen < 30) and
        (Row[x].rgbblue < 30) then
      begin
        Row[x].rgbblue := 255;
        Row[x].rgbgreen := 255;
        Row[x].rgbred := 255;
      end
      else
      begin
        Row[x].rgbblue := 0;
        Row[x].rgbgreen := 0;
        Row[x].rgbred := 0;
      end;
    end;
  end;
  Image1.Picture.Assign(bmp); // показать, как сработало преобразование в черно белое
  Image1.Picture.SaveToFile('filter.bmp');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Picture.LoadFromFile('000.bmp');
  // только для показа на форме
  bmp := tbitmap.Create;
  bmp.LoadFromFile('000.bmp');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  bmp.Free;
end;

function TForm1.scrin(x, y, h, w: integer): integer;
var
  DeskHw, DeskHdC: Longint;
begin
  DeskHw := getdesktopwindow;
  DeskHdC := getdc(DeskHw);
  Image2.Height := (h);
  Image2.Width := (w);
  BitBlt(Image2.Canvas.Handle, 0, 0, (w), (h), DeskHdC, (x), (y), SRCCOPY);
  Image2.Picture.SaveToFile('f.bmp');
  Image2.Picture := nil;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  scrin(335, 665, 18, 60);
end;

end.

[ClMlD]

Ништяк , спасибо огромное очень выручили . Тему можно закрывать =)