Показать сообщение отдельно

  #8  
Старый 19.01.2007, 20:48
Mirovan
Познающий
Регистрация: 10.04.2005
Сообщений: 49
Провел на форуме:
108176

Репутация: 12
Отправить сообщение для Mirovan с помощью ICQ
По умолчанию

Ну, вобщем приложение готово, работает по шаблону, всё очень просто

вот код

Код:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TMas = array[1..210, 1..65] of Boolean;

var
  Form1: TForm1;
  Mas: TMas;
  dir: String;

implementation

{$R *.dfm}

function JPEG2BMP(const JPGFile, BMPFile: string): boolean;
// Ôóíêöèÿ äëÿ êîíâåðòèðîâàíèÿ JPEG ôàéëà â <BMP>
// JPGFile - èìÿ îòêðûâàåìîãî ôàéëà
// BMPFile - èìÿ <ñîõðàíÿåìîãî> ôàéëà
var
  JPG: TJPEGImage;
  BMP: TBitmap;
begin
  JPG := TJPEGImage.Create;
  BMP := TBitmap.Create;
  try
    JPG.LoadFromFile(JPGFile);
    BMP.PixelFormat:= pf1bit;
    BMP.Assign(JPG);
    BMP.SaveToFile(BMPFile);
  finally
    FreeAndNil(JPG);
    FreeAndNil(BMP);
    Result := FileExists(BMPFile);
  end;
end;


function setBWColor(c: TColor): TColor;
begin
  if c > (255*255*255)/2
    then c := clWhite
    else c := clBlack;
  Result := c;
end;


function encodeImg(Mas: TMas): String;
type
  Tfiles = array[0..9] of String;
var
  f: Tfiles;
  i, j, k: Integer;
  shablon: array[1..32, 1..12] of Boolean;
  BMP: TBitmap;
  max, equal: Integer;
  temp, st: String;
begin
  for i := 0 to 9 do
    f[i] := dir + '/shablon/' + IntToStr(i) + '.bmp';

  BMP := TBitmap.Create;

  st := '';

  max := 0;
// 1 öèôðà
  for k := 0 to 9 do
    begin
      BMP.LoadFromFile(f[k]);
      for i := 1 to 32 do
        for j := 1 to 12 do
          if (BMP.Canvas.Pixels[i-1,j-1] = clWhite)
            then shablon[i,j] := true
            else shablon[i,j] := false;

      equal := 0;
      for i := 1 to 32 do
        for j := 1 to 12 do
          begin
            if shablon[i,j] = Mas[i+27,j+16] then equal := equal + 1;
          end;
      if (equal > max) then
        begin
          max := equal;
          temp := IntToStr(k);
        end;
    end;
  st := st + temp;

  max := 0;
// 2 öèôðà
  for k := 0 to 9 do
    begin
      BMP.LoadFromFile(f[k]);
      for i := 1 to 32 do
        for j := 1 to 12 do
          if (BMP.Canvas.Pixels[i-1,j-1] = clWhite)
            then shablon[i,j] := true
            else shablon[i,j] := false;

      equal := 0;
      for i := 1 to 32 do
        for j := 1 to 12 do
          begin
            if shablon[i,j] = Mas[i+54,j+16] then equal := equal + 1;
          end;
      if (equal > max) then
        begin
          max := equal;
          temp := IntToStr(k);
        end;
    end;
  st := st + temp;

  max := 0;
// 3 öèôðà
  for k := 0 to 9 do
    begin
      BMP.LoadFromFile(f[k]);
      for i := 1 to 32 do
        for j := 1 to 12 do
          if (BMP.Canvas.Pixels[i-1,j-1] = clWhite)
            then shablon[i,j] := true
            else shablon[i,j] := false;

      equal := 0;
      for i := 1 to 32 do
        for j := 1 to 12 do
          begin
            if shablon[i,j] = Mas[i+81,j+16] then equal := equal + 1;
          end;
      if (equal > max) then
        begin
          max := equal;
          temp := IntToStr(k);
        end;
    end;
  st := st + temp;

  max := 0;
// 4 öèôðà
  for k := 0 to 9 do
    begin
      BMP.LoadFromFile(f[k]);
      for i := 1 to 32 do
        for j := 1 to 12 do
          if (BMP.Canvas.Pixels[i-1,j-1] = clWhite)
            then shablon[i,j] := true
            else shablon[i,j] := false;

      equal := 0;
      for i := 1 to 32 do
        for j := 1 to 12 do
          begin
            if shablon[i,j] = Mas[i+108,j+16] then equal := equal + 1;
          end;
      if (equal > max) then
        begin
          max := equal;
          temp := IntToStr(k);
        end;
    end;
  st := st + temp;



  max := 0;
// 5 öèôðà
  for k := 0 to 9 do
    begin
      BMP.LoadFromFile(f[k]);
      for i := 1 to 32 do
        for j := 1 to 12 do
          if (BMP.Canvas.Pixels[i-1,j-1] = clWhite)
            then shablon[i,j] := true
            else shablon[i,j] := false;

      equal := 0;
      for i := 1 to 32 do
        for j := 1 to 12 do
          begin
            if shablon[i,j] = Mas[i+135,j+16] then equal := equal + 1;
          end;
      if (equal > max) then
        begin
          max := equal;
          temp := IntToStr(k);
        end;
    end;
  st := st + temp;



  max := 0;
// 6 öèôðà
  for k := 0 to 9 do
    begin
      BMP.LoadFromFile(f[k]);
      for i := 1 to 32 do
        for j := 1 to 12 do
          if (BMP.Canvas.Pixels[i-1,j-1] = clWhite)
            then shablon[i,j] := true
            else shablon[i,j] := false;

      equal := 0;
      for i := 1 to 32 do
        for j := 1 to 12 do
          begin
            if shablon[i,j] = Mas[i+162,j+16] then equal := equal + 1;
          end;
      if (equal > max) then
        begin
          max := equal;
          temp := IntToStr(k);
        end;
    end;
  st := st + temp;

  Result := st;

end;


procedure TForm1.Button1Click(Sender: TObject);
var
  h, w: Integer;
  Mas: TMas;
begin
  OpenPictureDialog1.Execute;
  JPEG2BMP(OpenPictureDialog1.FileName, dir+'/temp/temp.bmp');
  Image1.Picture.LoadFromFile(dir+'temp/temp.bmp');
  for w := 0 to Image1.Width-1 do
    for h := 0 to Image1.Height-1 do
      begin
        Image1.Canvas.Pixels[w,h] := setBWColor(Image1.Canvas.Pixels[w,h]);
        if (Image1.Canvas.Pixels[w,h] = clWhite)
          then Mas[w+1, h+1] := true   //áåëûé
          else Mas[w+1, h+1] := false; //÷åðíûé
      end;
  Edit1.Text := encodeImg(Mas);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  dir := ExtractFilePath(ParamStr(0));
end;

end.

p.s. работает только для картинки по адресу http://l2top.ru/?voteme=1139&rating=full , но на этой основе можно забадяжить своё
 
Ответить с цитированием